﻿/// /////////////////////////////////////////////
// 单元名 : unitCommonDataStruct
// 作者 : Hawk
// 单元描述 : 本单元定义系统中最基本的数据结构和常量
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
//{$CODEPAGE UTF8}
{$ENDIF}
unit unitCommonDataStruct;

interface

uses
  {$IFDEF MSWINDOWS}Windows, Messages,
  {$ENDIF}
  {$IFDEF LINUX}linux, BaseUnix, {$ENDIF}Types, unitIOCPDataObj, unitDDLinkList, unitClassIDDef, unitCommonTypes,
  unitMisc;

type
  ERRCODE = longword;

  TIPV6 = array [0 .. 15] of byte;

  TDeviceType = (dtWindows, dtLinux, dtAndroid, dtMac, dtIPhone);
  TRouteStatus = (rsNone, rsIdle, rsConnError, rsInConnecting, rsInReg, rsNormal);

  TID_MODULE = packed record
    class operator Equal(mid1, mid2: TID_MODULE): boolean;
    class operator NotEqual(mid1, mid2: TID_MODULE): boolean;
    function IsEmpty: longbool;
    procedure Empty;
    case integer of
      0: (ModuleID: word);
      1: (MajorID: byte;
        MinorID: byte);
  end;

  TID_HOST = packed record
    class operator Equal(const hid1, hid2: TID_HOST): boolean;
    class operator NotEqual(const hid1, hid2: TID_HOST): boolean;
    function IsEmpty: boolean;
    function ToStr: CommonString;
    procedure Empty;
    procedure FromStr(s: CommonString);
    procedure GeneralHostID;

    case integer of
      0: (HostID: array [0 .. 11] of byte);
      1: (HostIDLow: int64;
        HostIDHigh: longword);
  end;

  TID_SVR_MODULE = packed record
    Svr: byte;
    HostID: TID_HOST;
    ModuleID: TID_MODULE;
  end;

  TID_SUBID = packed record
    case integer of
      0: (IDBuf: array [0 .. 13] of byte);
      1: (HostID: TID_HOST;
        LUserID: word);
      2: (SessionIDs: array [0 .. 9] of byte;
        GenTime: longword);
  end;

  TID_OBJIDDETAIL = packed record
    ObjType: byte;
    case integer of
      0: (SvrMdl: TID_SVR_MODULE);
      1: (SubType: byte;
        SubID: TID_SUBID);
  end;

  TID_OBJ = packed record
    class operator Equal(const id1, id2: TID_OBJ): boolean;
    class operator NotEqual(const id1, id2: TID_OBJ): boolean;
    class operator GreaterThan(const id1, id2: TID_OBJ): boolean;
    class operator GreaterThanOrEqual(const id1, id2: TID_OBJ): boolean;
    class operator LessThan(const id1, id2: TID_OBJ): boolean;
    class operator LessThanOrEqual(const id1, id2: TID_OBJ): boolean;
    function ToString: CommonString;
    function IsWildCard(const id: TID_OBJ): boolean;
    function IsEmpty: boolean;
    procedure Empty;
    procedure GenericID(ot: byte = 0; st: byte = 0);
    procedure FromStr(s: CommonString);

    case integer of
      0: (IDDetail: TID_OBJIDDETAIL);
      2: (ObjIDLow, ObjIDHigh: int64);
  end;

  PID_OBJ = ^TID_OBJ;
  TObjIDArr = array of TID_OBJ;
  THostIDArr = array of TID_HOST;
  TLWArr = array of longword;

  TMES_REC = packed record
    case integer of
      0: (Value: longword);
      2: (id, Oper, MinorFunc, MajorFunc: byte);
      3: (aID, aOper: byte;
        Func: word);
  end;

  PMES_REC = ^TMES_REC;

  TSerialObj = class;
  TSerialObjClass = class of TSerialObj;

  TCOMBINE_PROPERTY_INFO = packed record
    Len: longword;
    Buf: Pointer;
  end;

  TCOMBINE_PROPERTY_INFOS = packed record
    Count: integer;
    Infos: array [0 .. 49] of TCOMBINE_PROPERTY_INFO;
  end;

  PCOMBINE_PROPERTY_INFOS = ^TCOMBINE_PROPERTY_INFOS;

  TSerialObjGroup = array of TSerialObj;
  TTreeStructChangeType = (tsctClear, tsctApp, tsctDel, tsctIns, tsctMov);
  TOnTreeStructChange = procedure(Sender: TSerialObj; changeType: TTreeStructChangeType;
    objs: array of TSerialObj) of object;

  {$IFDEF UI}

  TUIItem = record
    BindUI: TObject;
    case integer of
      0:
        (ItmIdx: nativeint;);
      1:
        (ItmObj: TObject);
  end;

  PUIItem = ^TUIItem;
  {$ENDIF}

  { TSerialObj }

  TSerialObj = class(TDoubleDirLinkListItem)
  private
    FObjID: TID_OBJ;
    FCaption: CommonString;

    function GetObj(Index: integer): TSerialObj;
    procedure SetCaption(const Value: CommonString);
    function GetParamByID(ClassID: longword): TSerialObj;
    procedure SetObjID(const Value: TID_OBJ);
  protected
    procedure ClearItems(FreeItem: boolean = True); override;
    procedure AppendItem(DDLLI: TDoubleDirLinkListItem; Debug: boolean = False); override;
    procedure DeleteItem(DDLLI: TDoubleDirLinkListItem; FreeItem: boolean = True; Debug: boolean = False); override;
    procedure InsertItem(DDLLI, Index: TDoubleDirLinkListItem); override;
    procedure MoveItem(DDLLI: TDoubleDirLinkListItem; Offset: integer = 1); override;
    procedure DoDumpObj; override;

    function CanAddSubObj(pnt, obj: TSerialObj): ERRCODE; virtual;
    function CanDelSubObj(pnt, obj: TSerialObj): ERRCODE; virtual;
    procedure DoSubObjAdded(pnt, obj: TSerialObj); virtual;
    procedure DoSubObjDeled(pnt, obj: TSerialObj); virtual;
    procedure DoModifyed; virtual;
    procedure DoClone(Target: TSerialObj); virtual;
    procedure DoAssign(Source: TSerialObj); virtual;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); virtual;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); virtual;

    procedure WritePropertyHeaderToPack(dp: TIOCPDataCollecter; Idx, Len: longword);
    procedure WriteCombinePropertyToPack(dp: TIOCPDataCollecter; Idx: longword;
      const CombineProperty: TCOMBINE_PROPERTY_INFOS);
    procedure WriteSize4ComboProperty(dp: TIOCPDataCollecter; Idx: longword; Propertys: array of longword);
    procedure WriteSize8ComboProperty(dp: TIOCPDataCollecter; Idx: longword; Propertys: array of Pointer);
    procedure WritePropertyToPack(dp: TIOCPDataCollecter; Idx, Len: longword; const Buf);
    procedure WritePropertyLSBToPack(dp: TIOCPDataCollecter; Idx, LSB: longword);
    procedure WriteAnsiStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: ansistring);
    procedure ReadAnsiStringFromPack(dp: TIOCPDataCollecter; var s: ansistring; Len: integer);
    procedure WriteUnicodeStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: unicodestring);
    procedure WriteCommonStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: CommonString; Force: boolean = False);
    procedure ForceWriteUnicodeStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: CommonString);
    procedure ReadUnicodeStringFromPack(dp: TIOCPDataCollecter; var s: unicodestring; Len: integer);
    procedure ReadCommonStringFromPack(dp: TIOCPDataCollecter; var s: CommonString; Len: integer);
    procedure WriteUnicodeStringPropertysToPack(dp: TIOCPDataCollecter; Idx: longword; strs: array of const);
    procedure ReadIntArrFromPack(dp: TIOCPDataCollecter; var s: TIntArr; Len: integer);
    procedure WriteIntArrToPack(dp: TIOCPDataCollecter; Idx: longword; const s: TIntArr);
  public
    {$IFDEF UI}
    UIItems: array of TUIItem;
    {$ENDIF}
    class function LoadFromPack(dp: TIOCPDataCollecter): TSerialObj;
    function CorrectClassID: longword; virtual;
    function MultiIDs(Idx: integer; var id: PID_OBJ): boolean; virtual;
    // 多 ID 对应同一个 obj，原则上通过此函数返回全部关联 ID ，包含对象本身的那个 ID
    function CanAddObj(obj: TSerialObj): ERRCODE;
    function CanDelObj(obj: TSerialObj): ERRCODE;

    procedure Return; override;

    procedure MaintainObjID;
    procedure ReadFromPack(dp: TIOCPDataCollecter);
    procedure WriteToPack(dp: TIOCPDataCollecter);

    function Clone(Recurrence: boolean = True): TSerialObj;
    procedure Assign(Source: TSerialObj; OnlySelf: boolean = False);
    procedure AddObj(obj: TSerialObj);
    procedure DelObj(obj: TSerialObj);
    procedure MoveObj(obj, Idx: TSerialObj);
    procedure InsertObj(obj, Idx: TSerialObj);

    function CheckIsAncent(obj: TSerialObj): longbool;
    function FindItem(const id: TID_OBJ): TSerialObj; overload;
    function FindItems(Cap: CommonString): TSerialObjGroup;
    function FilteItems(Cap: CommonString): TSerialObjGroup;
    function FindItemNoMe(const id: TID_OBJ): TSerialObj; overload;
    function FindItemLowerLevel(const id: TID_OBJ): TSerialObj; overload;
    function FindItemLowerLevel(Caption: CommonString): TSerialObj; overload;
    function GetObjByID(const id: TID_OBJ; ObjCls: TSerialObjClass): Pointer;
    function GetObjByName(Cap: CommonString; ObjCls: TSerialObjClass): Pointer;

    procedure Merge(List: TSerialObj);
    function Update(obj: TSerialObj): TSerialObj;
    {$IFDEF UI}
    function UIItemCount: integer;
    function NewUIItem(ui: TObject): PUIItem;
    procedure DelUIItem(ui: TObject);
    procedure SetUIItem(ui: TObject; itemvalue: nativeint = -1);
    procedure ResetUIItems(ui: TObject);
    {$ENDIF}
    procedure Clear;

    property ObjID: TID_OBJ read FObjID write SetObjID;
    property Caption: CommonString read FCaption write SetCaption;
    property obj[Index: integer]: TSerialObj read GetObj;
    property ParamByID[ClassID: longword]: TSerialObj read GetParamByID;
  end;

  TStubObj = class(TSerialObj)
  private
    {$MESSAGE warn '此类只能在本机使用，不能用于传输，所以没有序列化重载'}
    FRealObj: TSerialObj;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    property RealObj: TSerialObj read FRealObj write FRealObj;
  end;

  TFuncInfo = class(TSerialObj)
  private
    function GetFuncDesc: CommonString;
    procedure SetFuncDesc(const Value: CommonString);
  protected
  public
    class function ClassID: longword; override;

    property FuncOrOperDesc: CommonString read GetFuncDesc write SetFuncDesc;
  end;

  TStringObj = class(TSerialObj)
  private
    FStr: CommonString;
    FFlag: longword;
    FData: Pointer;
    procedure SetStr(const Value: CommonString);
    procedure SetFlag(const Value: longword);
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
    procedure DoDumpObj; override;
  public
    class function ClassID: longword; override;
    procedure Return; override;
    property Str: CommonString read FStr write SetStr;
    property Flag: longword read FFlag write SetFlag;
    property Data: Pointer read FData write FData;
  end;

  TDataSet = TStringObj;
  TStoreList = class;
  TGetRecord = function(obj: TSerialObj; const ReqSource, ReqUID: TID_OBJ): TSerialObj of object;
  TGetRecords = procedure(rtbl: TStoreList; const ReqSource, ReqUID: TID_OBJ) of object;
  TCanAddRecord = function(pnt: TSerialObj; const sid, uid: TID_OBJ; var obj, eObj: TSerialObj): ERRCODE of object;
  TCanDelRecord = function(obj: TSerialObj; const sid, uid: TID_OBJ): ERRCODE of object;
  TOnTableUpdated = procedure(rtbl: TStoreList) of object;
  TOnRecordUpdated = procedure(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ) of object;
  TOnRecordDeled = procedure(Sender: TObject; obj: TSerialObj; const sid, uid: TID_OBJ) of object;

  TStoreList = class(TSerialObj)
  private
    FCanAddObj: TCanAddRecord;
    FCanDelObj: TCanDelRecord;
    FGetRecord: TGetRecord;
    FGetRecords: TGetRecords;
    FRecordUpdated: TEventNotifys;
    FTableUpdated: TEventNotifys;
    FRecordDeled: TEventNotifys;
    FLastError: ERRCODE;
    FAllowSameName: boolean;
    procedure SetAllowSameName(const Value: boolean);
    procedure RescureRecordUpdated(obj: TSerialObj; const sid, uid: TID_OBJ);
  protected
    procedure SetLastErrcode(ec: ERRCODE);
  public
    class function ClassID: longword; override;
    procedure Return; override;

    function UpdateObj(const pnt: TID_OBJ; obj: TSerialObj; const sid, uid: TID_OBJ): TSerialObj; virtual;
    function GetOrNewObj(sertype: TSerialObjClass): TSerialObj;
    function DelObj(const id: TID_OBJ; const sid, uid: TID_OBJ): ERRCODE;
    function RegedEventNotifyCount: integer;

    procedure AddRdUpdated(tu: TOnRecordUpdated);
    procedure DelRdUpdated(tu: TOnRecordUpdated);
    procedure AddRdDeled(tu: TOnRecordDeled);
    procedure DelRdDeled(tu: TOnRecordDeled);
    procedure AddTblUpdated(tu: TOnTableUpdated);
    procedure DelTblUpdated(tu: TOnTableUpdated);
    procedure NotifyTableUpdated(const sid, uid: TID_OBJ);
    procedure NotifyRecordUpdated(ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure NotifyRecordDeled(obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure SetLastError(e: ERRCODE);

    property LastError: ERRCODE read FLastError;
    property AllowSameName: boolean read FAllowSameName write SetAllowSameName;
    property GetRecord: TGetRecord read FGetRecord write FGetRecord;
    property GetRecords: TGetRecords read FGetRecords write FGetRecords;
    property CanAddRecord: TCanAddRecord read FCanAddObj write FCanAddObj;
    property CanDelRecord: TCanDelRecord read FCanDelObj write FCanDelObj;
  end;

  TFileContent = class(TSerialObj)
  private
    FFileModTime: longword;
    function GetFileName: CommonString;
    procedure SaveToTempFile(Buf: TIOCPDataCollecter; Len: longword);
    procedure SetFileName(const Value: CommonString);
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    property FileName: CommonString read GetFileName write SetFileName;
    property FileModTime: longword read FFileModTime;
  end;

  TFileInfo = class(TSerialObj)
  private
    FSize: TFILE_SIZE;
    FModTime: longword;
    procedure SetModTime(const Value: longword);
    procedure SetSize(const Value: TFILE_SIZE);
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    property Size: TFILE_SIZE read FSize write SetSize;
    property ModTime: longword read FModTime write SetModTime;
  end;

  TObjProperty = record
    id: longword;
    BufLen: longword;
    case integer of
      1: (fBuf: int64);
      2: (pBuf: Pointer);
  end;

  TDefaultObj = class(TSerialObj)
  private
    FRealClassID: longword;
    FPropertys: array of TObjProperty;
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: longword; override;
    procedure Return; override;
    function CorrectClassID: longword; override;
  end;

  TSize4DataSet = class(TSerialObj)
  private
    FDatas: array of longword;
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
    procedure DoDumpObj; override;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    function DataCount: integer;
    function GetData(Idx: integer): longword;
    procedure DelDatas(c: integer);
    procedure Clear;
    procedure AddData(d: longword);
    procedure SetData(Idx: integer; d: longword);
  end;

  TMilliSecParam = class(TSerialObj)
  private
    FIOCPKey: nativeuint;
    FIOCPMsg: longword;
    FIOCPPort: nativeuint;
    procedure SetIOCPKey(const Value: nativeuint);
    procedure SetIOCPMsg(const Value: longword);
    procedure SetIOCPPort(const Value: nativeuint);
  public
    class function ClassID: longword; override;
    procedure Return; override;

    property IOCPPort: nativeuint read FIOCPPort write SetIOCPPort;
    property IOCPKey: nativeuint read FIOCPKey write SetIOCPKey;
    property IOCPMsg: longword read FIOCPMsg write SetIOCPMsg;
  end;

  TGetTableID = function: longword of object;

  TSerialFile = class(TSerialObj)
  private
    FStoreFileName: CommonString;
    FModifyed: boolean;
    FDirectFileAccess: boolean;
  protected
    procedure DoModifyed; override;
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;

    procedure DoFileLoaded; virtual;

    function ReadFileData(FileName: CommonString): TIOCPDataCollecter;
    procedure WriteDataToFile(FileName: CommonString; dp: TIOCPDataCollecter);
    procedure SetModifyed(Value: boolean);
    procedure TranslateID;
  public
    class function LoadFromFile(FileName: CommonString): TSerialFile;

    function GetStoreList(const id: TID_OBJ): TStoreList; overload;
    function InitTable(const id: TID_OBJ; Name: CommonString; cls: TSerialObjClass): Pointer;
    procedure ReadFromFile(FileName: CommonString = '');
    procedure WriteToFile(FileName: CommonString = ''; Force: boolean = False);
    procedure MaintainIDs;

    property StoreFileName: CommonString read FStoreFileName write FStoreFileName;
    property DirectFileAccess: boolean read FDirectFileAccess write FDirectFileAccess;
    property Modifyed: boolean read FModifyed;
  end;

const
  OBJTYPE_ENTITY = 0;
  OBJTYPE_CLASS = 1;
  OBJTYPE_PICTURE = 2;
  OBJTYPE_VIDEO = 3;
  OBJTYPE_SVCPROVIDER = 4;
  OBJTYPE_ID = 5;
  OBJTYPE_TOCKEN = 6;
  OBJTYPE_FILE = 7;
  OBJTYPE_SESSION = 8;
  OBJTYPE_LOW = 0;
  OBJTYPE_HIGH = 8;

  IDSUBTYPE_TABLE = 0;
  IDSUBTYPE_RECORD = 1;
  IDSUBTYPE_FUNCTION = 2;

  IDSUBTYPE_LOW = 0;
  IDSUBTYPE_HIGH = 2;

  L_SESSIONALIVE = 30 * 60; // 会话ID生存时长：30 分钟

  HOSTID_EMPTY: TID_HOST = (HostID: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
  HOSTID_LOCAL: TID_HOST = (HostID: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
  HOSTID_LOCALSVR: TID_HOST = (HostID: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
  HOSTID_ROOT: TID_HOST = (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0));
  HOSTID_ALLMASK: TID_HOST = (HostID: ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF));

  MAJOR_MASK: TID_MODULE = (MajorID: $FF);
  MINOR_MASK: TID_MODULE = (MinorID: $FF);
  EMPTY_ID_MODULE: TID_MODULE = (ModuleID: 0);
  EMPTY_ID_OBJ: TID_OBJ = (ObjIDLow: 0; ObjIDHigh: 0);
  MAJOR_MASK_LOCAL: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: $FF))));
  MASK_LOCALUI: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ENTITY; SvrMdl: (Svr: $FF; ModuleID: (ModuleID: $FFFF))));
  MASK_ALL: TID_OBJ = (ObjIDLow: -1; ObjIDHigh: -1);
  MASK_ALLHOSTMODULE: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ENTITY; SubType: $FF;
    SubID: (IDBuf: ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF))));
  MASK_ALLHOSTUID: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SubType: IDSUBTYPE_RECORD;
    SubID: (IDBuf: ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF))));
  MASK_LOCALALL: TID_OBJ = (IDDetail: (ObjType: $FF; SvrMdl: (Svr: $FF; ModuleID: (ModuleID: $FFFF))));
  MASK_LOCALALLUID: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SvrMdl: (Svr: IDSUBTYPE_RECORD;
    HostID: (HostIDLow: 0; HostIDHigh: 0); ModuleID: (ModuleID: $FFFF))));
  MASK_LOCALALLMODULE: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ENTITY; SvrMdl: (Svr: $FF;
    ModuleID: (ModuleID: $FFFF))));
  MASK_LOCALALLMODULENOUI: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ENTITY; SvrMdl: (ModuleID: (ModuleID: $FFFF))));
  ID_USERROOT_LOCAL: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SvrMdl: (Svr: IDSUBTYPE_RECORD;
    ModuleID: (ModuleID: 1))));
  ID_USERROOT_ROOTHOST: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SvrMdl: (Svr: IDSUBTYPE_RECORD;
    HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0)); ModuleID: (ModuleID: 1))));
  MASK_ROOTUI: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ENTITY;
    SvrMdl: (Svr: $FF; HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0));
    ModuleID: (ModuleID: $FFFF))));

  // 默认的服务端模块ID
  AUTHMODULE_ID: TID_MODULE = (MajorID: 1);
  SVRMODULE_ID: TID_MODULE = (MajorID: 3);
  COMPILERMODULE_ID: TID_MODULE = (MajorID: 4);
  SALEMODULE_ID: TID_MODULE = (MajorID: 5);
  UNIQUEDATAMODULE_ID: TID_MODULE = (MajorID: 6);
  TRANSACTIONMODULE_ID: TID_MODULE = (MajorID: 7);
  SVRMNGMODULE_ID: TID_MODULE = (MajorID: 8);
  LOGSERVERMODULE_ID: TID_MODULE = (MajorID: 10);
  FILEANDTRANSMODULE_ID: TID_MODULE = (MajorID: 11);
  AVISVRMODULE_ID: TID_MODULE = (MajorID: 13);
  LOTTERMODULE_ID: TID_MODULE = (MajorID: 250);

  OBJID_LOCAL: TID_OBJ = (ObjIDLow: 0; ObjIDHigh: 0);
  OBJID_LOCALSVR: TID_OBJ = (ObjIDLow: 0; ObjIDHigh: 0);
  OBJID_AUTHMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 1))));
  OBJID_SVRMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 3))));
  OBJID_COMPILERMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 4))));
  OBJID_UNIQUEDATAMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 6))));
  OBJID_TRANSACTIONMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 7))));
  OBJID_SVRMNGMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 8))));
  OBJID_LOGSERVERMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 10))));
  OBJID_FILEANDTRANSMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 11))));
  OBJID_AVISVRMODULE: TID_OBJ = (IDDetail: (SvrMdl: (ModuleID: (MajorID: 13))));

  ROOTID_MAJORMASK: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0)); ModuleID: (MajorID: $FF))));
  ROOTID_AUTHMODULE: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0)); ModuleID: (MajorID: 1))));
  ROOTID_SVRMODULE: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0)); ModuleID: (MajorID: 3))));
  ROOTID_COMPILERMODULE: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0, $F0)); ModuleID: (MajorID: 4))));
  ROOTID_SALEMODULE: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0)); ModuleID: (MajorID: 5))));
  ROOTID_UNIQUEDATAMODULE: TID_OBJ =
    (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0));
    ModuleID: (MajorID: 6))));
  ROOTID_TRANSACTIONMODULE: TID_OBJ =
    (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0));
    ModuleID: (MajorID: 7))));
  ROOTID_SVRMNGMODULE: TID_OBJ = (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0,
    $F0, $F0, $F0)); ModuleID: (MajorID: 8))));
  ROOTID_FILEANDTRANMODULE: TID_OBJ =
    (IDDetail: (SvrMdl: (HostID: (HostID: ($F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0, $F0));
    ModuleID: (MajorID: 11))));

  MESID_MAJORFUNC_SHIFT = 24;
  MESID_MINORFUNC_SHIFT = 16;
  MESID_OPERATOR_SHIFT = 8;
  MESID_MAJORFUNC_MASK = $FF000000;
  MESID_MINORFUNC_MASK = $00FF0000;
  MESID_OPERATOR_MASK = $0000FF00;
  MESID_OPERATOR_ACCESS = $00000100;
  MESID_OPERATOR_ADD = $00000200;
  MESID_OPERATOR_MODIFY = $00000400;
  MESID_OPERATOR_DELETE = $00000800;
  MESID_OPERATOR_AUDIT = $00001000;
  MESID_OPERATOR_ACCESSSUB = $00002000;
  MESID_OPERATOR_INTERNAL = $00008000;
  MESID_RETURN = $00004000;
  MESID_ACCESS_DENIED = $FFFFFFFF;
  MESID_INVALID_REQUEST = $FFFFFFFE;
  MAJORFUNC_COUNT = 256;
  MINORFUNC_COUNT = 256;
  PRIORITY_COUNT = MAJORFUNC_COUNT * MINORFUNC_COUNT;
  PRIORITY_ACCESS = $01;
  PRIORITY_ADD = $02;
  PRIORITY_MODIFY = $04;
  PRIORITY_DELETE = $08;
  PRIORITY_AUDIT = $10;
  PRIORITY_SPECIAL = $20;
  PRIORITY_INTERNAL = $80;

  // 消息 ID 的范围定义：从 1 - 100000
  // 其他模块的消息需要从 100001 开始
  MSGID_ALL_START = MESID_OPERATOR_INTERNAL + 1; // 全局消息：启动模块
  MSGID_ALL_START2 = MESID_OPERATOR_INTERNAL + 9; // 全局消息：启动模块2
  MSGID_ALL_STOP = MESID_OPERATOR_INTERNAL + 2; // 全局消息：停止模块
  MSGID_ALL_QUERYSTATE = MESID_OPERATOR_INTERNAL + 3; // 全局消息：查询模块状态
  MESID_ALL_SERVERNOTIFY = 4; // 全局消息：服务器通知
  MESID_ALL_GETFUNCTION_INFO = 5; // 全局消息：获取功能信息
  MESID_ALL_RETURNFUNC_INFO = 6; // 全局消息：返回功能信息
  MESID_ALL_ROOTSTATUSCHANGED = MESID_OPERATOR_INTERNAL + 7; // 全局消息：到根对象的路由变化
  MESID_ALL_USERLOGINTED = MESID_OPERATOR_INTERNAL + 8; // 全局消息：到根对象的登录已经完成
  MESID_ALL_TIMER = MESID_OPERATOR_INTERNAL + 10; // 全局消息：时钟：每秒一次
  MESID_ALL_PROCOBJONLINE = MESID_OPERATOR_INTERNAL + 11; // 全局消息：主消息处理对象上线
  MESID_ALL_PROCOBJOFFLINE = MESID_OPERATOR_INTERNAL + 12; // 全局消息：主消息处理对象下线
  MESID_ALL_ONTIMER_SAVECONFIG = MESID_OPERATOR_INTERNAL + 13;
  // 全局消息：定时存储配置；每天一次
  MESID_ALL_TERMINATE = MESID_OPERATOR_INTERNAL + 14; // 全局消息：终止进程
  MESID_ALL_HOURTIMER = MESID_OPERATOR_INTERNAL + 15; // 全局消息：每小时一次的时钟消息
  MESID_ALL_REG_DEBUG = 16;
  MESID_ALL_UNREG_DEBUG = 17;
  // MESID_ALL_DEBUGINFO = 18;
  MESID_ALL_IMMEDIATELI_DEBUG = MESID_OPERATOR_INTERNAL + 19;
  MESID_ALL_EXECWORKITEM = MESID_OPERATOR_INTERNAL + 20;
  MESID_ALL_EXECWORKITEM_COMPLETE = MESID_OPERATOR_INTERNAL + 21;
  MESID_ALL_SHOWTOPMESSAGE = MESID_OPERATOR_INTERNAL + 22;
  // MESID_ALL_TRANS_GETLIST = MESID_OPERATOR_INTERNAL + 24;
  // MESID_ALL_TRANS_CREATE = MESID_OPERATOR_INTERNAL + 25;
  // MESID_ALL_TRANS_START = MESID_OPERATOR_INTERNAL + 26;
  // MESID_ALL_TRANS_PAUSE = MESID_OPERATOR_INTERNAL + 27;
  // MESID_ALL_TRANS_STOP = MESID_OPERATOR_INTERNAL + 28;
  // MESID_ALL_TRANS_DELETE = MESID_OPERATOR_INTERNAL + 29;
  MESID_ALL_DESKTOP_START = MESID_OPERATOR_INTERNAL + 30;
  MESID_ALL_DESKTOP_STOP = MESID_OPERATOR_INTERNAL + 31;
  MESID_ALL_DESKTOP_STATUS = MESID_OPERATOR_INTERNAL + 32;
  MESID_ALL_REGMILLISECOND = MESID_OPERATOR_INTERNAL + 33;
  MESID_ALL_UNREGMILLISECOND = MESID_OPERATOR_INTERNAL + 34;
  MESID_ALL_MILLISECOND = MESID_OPERATOR_INTERNAL + 35;
  MSGID_ALL_STOP2 = MESID_OPERATOR_INTERNAL + 36; // 全局消息：停止模块2
  MSGID_ALL_DEBUG = MESID_OPERATOR_INTERNAL + 37; // 全局消息：启动调试

  MESID_ALL_RETURN = 1000;
  MESID_ALL_RETURNSTATE = MESID_ALL_RETURN + MESID_OPERATOR_INTERNAL + 1;
  // 全局消息：返回状态
  MESID_ALL_RETURN_OBJNOTEXIST = MESID_ALL_RETURN + 2; // 全局消息：请求的对象不存在
  MESID_ALL_STARTCOMPLETE = MESID_ALL_RETURN + MESID_OPERATOR_INTERNAL + 3;
  // 全局消息：模块启动已经执行完毕
  MESID_ALL_STOPCOMPLETE = MESID_ALL_RETURN + MESID_OPERATOR_INTERNAL + 4;
  // 全局消息：模块停止已经执行完毕
  MESID_ALL_USERINFO = MESID_ALL_RETURN + 5; // 全局消息：当前账户信息
  MESID_ALL_TRANSLIST = MESID_ALL_RETURN + 10; // 全局消息：事务列表
  MESID_ALL_TRANS_STATUS = MESID_ALL_RETURN + 11; // 全局消息：事务状态改变

  DBGCONTENT_FILETRANS = 1000;
  DBGCONTENT_NETMSG = 1001;

  {$IFDEF MSWINDOWS}
  WM_CLIENT_MESSAGE = WM_APP + $1000; // 这是本系统与出口系统之间的交互消息定义
  WM_MESSAGE = WM_CLIENT_MESSAGE + 1;
  // 本系统接收到一个消息之后会发出本出口消息通知关联的窗口
  {$ENDIF}
  SERVERSTORAGE_ROOT = 'ServerStorage\'; // 服务器端存储的根目录名
  S_SALEMODULE_PATH = 'Sale\';
  BACKUPPROJSTORE_PATH = 'ProjectsBackup\';
  CLIENT_FILEPATH = 'Client\';
  TEMP_FILEPATH = 'upload\';
  SYNCCENTER_PATH = 'SyncCenter\';
  UPDATEMODULE_PATH = 'Update\';
  COMPILERMODULE_PATH = 'Compiler\';
  LOGMODULE_PATH = 'Log\';
  VERINFO_FILENAME = 'verinfo.ver';
  USERDEFINE_FILENAME = 'Users.Define';
  OFFLINEMSG_FILENAME = 'offlinemsg.store';
  // PROJECTSTORE_FILENAME = 'Project.store';
  // BACKUPPROJSTORE_FILENAME = 'ProjectBackup-%d-%d-%d.store';
  FILETASKSSTORE_FILENAME = 'FileTasks.store';
  FILELIBSTORE_FILENAME = 'FileLib.store';
  UIDESCRIPTOR_FILENAME = 'UIDesc.dat';
  UPDATE_FILENAME = 'updater.zip';
  COMPILERINFO_FILENAME = 'Compiler.config';
  AVINFO_FILENAME = 'AVInfo.data';
  AVUSERENTRY_FILENAME = 'UserEntry.data';

  L_TAIL_DEVHISTORY = 65530;
  L_TAIL_REMOTEDEV = 65531;
  L_TAIL_LOGINOBJ = 65532;
  S_ROOTDOMAIN: array [0 .. 1] of CommonString = ('bighawk.3322.org', '192.168.1.2');
  I_ROOTPORT = 18521;
  L_LOCALIP = $0100007F;
  W_PORTNET = $5948;

  I_ROUTESTATUS_NONE = 0;
  I_ROUTESTATUS_BREAK = 1; // 断开
  I_ROUTESTATUS_DNSFAIL = 2; // 无法解析地址，包括不能从Root获得对端地址
  I_ROUTESTATUS_CONNECTING = 4; // 无法解析地址，包括不能从Root获得对端地址
  I_ROUTESTATUS_UNREGED = 8; // 能连接，但不能注册。SessionID错误
  I_ROUTESTATUS_ROUTED = $10; // 直接连接，还未检测 SessinID
  I_ROUTESTATUS_NORMAL = $20; // 直接连接，并已经检测SessionID通过
  I_ROUTESTATUS_LOGINED = $40; // 已经登录到对端，可能未必通过直连
  I_ROUTESTATUS_LOGINFAIL = $80; // 登录到对端失败
  I_ROUTESTATUS_ROOTNORMAL = $100; // 对端已经注册到 Root

  I_DESKSTATUS_STARTED = 1;
  I_DESKSTATUS_DATA = 2;
  I_DESKSTATUS_STOPED = 3;

  TABLEID_USERLIST = 10;
  TABLEID_COMPILESCRIPT = 11;
  TABLEID_COMPILESCRIPTQUEUE = 12;
  TABLEID_LOCALPATH = 100;
  // IDX_CAPTION = 121;
  IDX_OBJID = 122;
  IDX_CAPTIONU8 = 123;
  IDX_SERIALLOW = 121;
  IDX_SERIALHIGH = 127;
  SMODULENAME_ROOT = '根模块';
  SMODULENAME_AAA = 'AAA 模块';
  SMODULENAME_SVR = '路由模块';
  SMODULENAME_COMPILER = '编译模块';
  SMODULENAME_SALE = '销售模块';
  SMODULENAME_UNIQUEDATA = '统一数据处理模块';
  SMODULENAME_SVRMNG = '主机管理模块';
  SMODULENAME_LOG = '日志模块';
  SMODULENAME_FILEANDTRANS = '文件和传输模块';
  SMODULENAME_TRANSACTMNG = '事务模块';

  S_DEF_FONTNAME = '微软雅黑';
  S_UNKNOWNHOST = '未知主机';

  S_OBJID = 'ObjID';
  S_CAPTION = 'Caption';

  S_ROOTSTATUS_DNSFAIL = '无法解析主机地址，请确认已经连接到网络';
  S_ROOTSTATUS_ROUTED = '到主机的路由已经连通';
  S_ROOTSTATUS_NORMAL = '到主机的路由正常';
  S_ROOTSTATUS_BREAK = '到根主机的路由已断开';
  S_ROOTSTATUS_LOGINED = '已登录到根主机，用户名：%s';
  S_ROOTSTATUS_LOGINFAIL = '登录到根主机失败';
  S_PRIORITYDESC: array [0 .. 5] of CommonString = ('访问', '添加', '修改', '删除', '审计', '遍历');

const
  // 以下ID用于从数据流中读取 Serial 对象
  OBJFLAG_CLASSID = longword(-3);
  OBJFLAG_PROPERTY = longword(-2);
  OBJFLAG_END = longword(-1);
  OBJFLAG_CLASSID_LSB = 125;
  OBJFLAG_PROPERTY_LSB = 126;
  OBJFLAG_END_LSB = 127;
  S_OBJTYPE_CHAR: array [OBJTYPE_LOW .. OBJTYPE_HIGH] of CommonChar = ('E', 'C', 'P', 'V', 'S', 'I', 'T', 'F', 'N');

function MakeModuleID(MajorID, MinorID: integer): TID_MODULE; overload;
function MakeObjID(const HostID: TID_HOST; ModuleID: TID_MODULE): TID_OBJ; overload;
function MakeObjID(ObjType, Svr: byte; const HostID: TID_HOST; ModuleID: TID_MODULE): TID_OBJ; overload;
function MakeFixedObjID(const hid: TID_HOST; Tail: word): TID_OBJ;
function MakeLoginObjID(const hid: TID_HOST): TID_OBJ;
function MakeDevHistoryID(const hid: TID_HOST): TID_OBJ;
function MakeRemoteDevID(const hid: TID_HOST): TID_OBJ;
function CombineObjID(const oid: TID_OBJ; mid: TID_MODULE): TID_OBJ;
function ObjInGroup(eg: TSerialObjGroup; obj: TSerialObj): longbool;
function ModuleName(const id: TID_OBJ): CommonString;
function RouteStatusToStr(rs: longword): CommonString;
function CombinePriorityToStr(mask: longword): CommonString;
function EnumPath(path: CommonString; fullpath: boolean = False; IncludeSubDir: boolean = True): TStringObj;
function FlatEnumPath(path: CommonString; extfilter: TCommStrArr): TStringObj;
function DelFromIDArr(var ids: TObjIDArr; const id: TID_OBJ): ERRCODE; overload;
function LWInArr(const lws: TLWArr; lw: longword): boolean;
function AddToLWArr(var lws: TLWArr; lw: longword): ERRCODE;
function AddToIDArr(var ids: TObjIDArr; const id: TID_OBJ): ERRCODE;
function AddToHostIDArr(var ids: THostIDArr; const id: TID_HOST): ERRCODE;
function DelFromHostIDArr(var ids: THostIDArr; const id: TID_HOST): ERRCODE; overload;
function GenSessionID(CurTick: longword): TID_OBJ;
procedure DelFromLWArr(var lws: TLWArr; Idx: integer); overload;
procedure DelLWFromLWArr(var lws: TLWArr; lw: longword); overload;
procedure DelFromIDArr(var ids: TObjIDArr; Idx: integer); overload;
procedure DelFromHostIDArr(var ids: THostIDArr; Idx: integer); overload;
procedure CombineObjGroup(var group: TSerialObjGroup; g1: TSerialObjGroup);
procedure AddToObjGroup(var group: TSerialObjGroup; o: TSerialObj);
procedure DelFromObjGroup(var group: TSerialObjGroup; o: TSerialObj; delAll: boolean = False);
procedure CombineLWARR(var lws: TLWArr; const p: TLWArr);
// procedure AnalyMsgID(msgID: LongWord; var MajFunc, MinFunc, MsgFunc: byte);

implementation

uses SysUtils, unitObjPool{$IFDEF DEBUG}, Rtti{$ENDIF}, unitErrCodeDef;

function ModuleName(const id: TID_OBJ): CommonString;
begin
  case id.IDDetail.SvrMdl.ModuleID.MajorID of
    0:
      Result := SMODULENAME_ROOT;
    1:
      Result := SMODULENAME_AAA;
    3:
      Result := SMODULENAME_SVR;
    4:
      Result := SMODULENAME_COMPILER;
    5:
      Result := SMODULENAME_SALE;
    6:
      Result := SMODULENAME_UNIQUEDATA;
    7:
      Result := SMODULENAME_TRANSACTMNG;
    8:
      Result := SMODULENAME_SVRMNG;
    10:
      Result := SMODULENAME_LOG;
    11:
      Result := SMODULENAME_FILEANDTRANS;
    else
      Result := '';
  end;
end;

function RouteStatusToStr(rs: longword): CommonString;
var
  l: longword;
begin
  Result := '';
  l := $80;
  while l <> 0 do
  begin
    if rs and l <> 0 then
      case l of
        I_ROUTESTATUS_DNSFAIL:
          Result := Result + ',' + S_ROOTSTATUS_DNSFAIL;
        I_ROUTESTATUS_ROUTED:
          Result := Result + ',' + S_ROOTSTATUS_ROUTED;
        I_ROUTESTATUS_NORMAL:
          Result := Result + ',' + S_ROOTSTATUS_NORMAL;
        I_ROUTESTATUS_BREAK:
          Result := Result + ',' + S_ROOTSTATUS_BREAK;
        I_ROUTESTATUS_LOGINED:
          Result := Result + ',' + S_ROOTSTATUS_LOGINED;
        I_ROUTESTATUS_LOGINFAIL:
          Result := Result + ',' + S_ROOTSTATUS_LOGINFAIL;
      end;
    l := l shr 1;
  end;
  if Result <> '' then
    Delete(Result, 1, 1);
end;

function CombinePriorityToStr(mask: longword): CommonString;
var
  l: longword;
  i: integer;
begin
  Result := '';
  l := MESID_OPERATOR_ACCESS;
  for i := Low(S_PRIORITYDESC) to High(S_PRIORITYDESC) do
  begin
    if mask and l <> 0 then
      Result := Result + ',' + S_PRIORITYDESC[i];
    l := l shl 1;
  end;
  if Result <> '' then
    Delete(Result, 1, 1)
  else
    Result := '无权限';
end;

procedure AddToObjGroup(var group: TSerialObjGroup; o: TSerialObj);
var
  l: integer;
begin
  l := Length(group);
  SetLength(group, l + 1);
  group[l] := o;
end;

procedure DelFromObjGroup(var group: TSerialObjGroup; o: TSerialObj; delAll: boolean);
var
  i: integer;
begin
  for i := High(group) downto Low(group) do
    if group[i] = o then
    begin
      if i <> High(group) then
        group[i] := group[High(group)];
      SetLength(group, Length(group) - 1);
      if not delAll then
        Break;
    end;
end;

function LWInArr(const lws: TLWArr; lw: longword): boolean;
var
  i: integer;
begin
  Result := False;
  for i := Low(lws) to High(lws) do
    if lws[i] = lw then
    begin
      Result := True;
      Break;
    end;
end;

function AddToLWArr(var lws: TLWArr; lw: longword): ERRCODE;
var
  i: integer;
begin
  for i := Low(lws) to High(lws) do
    if lws[i] = lw then
    begin
      Result := ERRCODE_OBJEXIST;
      Exit;
    end;
  i := Length(lws);
  SetLength(lws, i + 1);
  lws[i] := lw;
  Result := ERRCODE_NOERROR;
end;

function AddToIDArr(var ids: TObjIDArr; const id: TID_OBJ): ERRCODE;
var
  i: integer;
begin
  for i := Low(ids) to High(ids) do
    if ids[i] = id then
    begin
      Result := ERRCODE_OBJEXIST;
      Exit;
    end;
  i := Length(ids);
  SetLength(ids, i + 1);
  ids[i] := id;
  Result := ERRCODE_NOERROR;
end;

function DelFromIDArr(var ids: TObjIDArr; const id: TID_OBJ): ERRCODE;
var
  i: integer;
begin
  for i := Low(ids) to High(ids) do
    if ids[i] = id then
    begin
      DelFromIDArr(ids, i);
      Result := ERRCODE_NOERROR;
      Exit;
    end;
  Result := ERRCODE_OBJNOTEXIST;
end;

function AddToHostIDArr(var ids: THostIDArr; const id: TID_HOST): ERRCODE;
var
  i: integer;
begin
  for i := Low(ids) to High(ids) do
    if ids[i] = id then
    begin
      Result := ERRCODE_OBJEXIST;
      Exit;
    end;
  i := Length(ids);
  SetLength(ids, i + 1);
  ids[i] := id;
  Result := ERRCODE_NOERROR;
end;

function DelFromHostIDArr(var ids: THostIDArr; const id: TID_HOST): ERRCODE; overload;
var
  i: integer;
begin
  for i := Low(ids) to High(ids) do
    if ids[i] = id then
    begin
      DelFromHostIDArr(ids, i);
      Result := ERRCODE_NOERROR;
      Exit;
    end;
  Result := ERRCODE_OBJNOTEXIST;
end;

function GenSessionID(CurTick: longword): TID_OBJ;
begin
  Result.GenericID(OBJTYPE_SESSION, IDSUBTYPE_RECORD);
  Result.IDDetail.SubID.GenTime := CurTick;
end;

procedure DelFromLWArr(var lws: TLWArr; Idx: integer);
begin
  if (Idx >= Low(lws)) and (Idx <= High(lws)) then
  begin
    if Idx <> High(lws) then
      lws[Idx] := lws[High(lws)];
    Idx := Length(lws);
    SetLength(lws, Idx - 1);
  end;
end;

procedure DelLWFromLWArr(var lws: TLWArr; lw: longword);
var
  i, l: integer;
begin
  for i := Low(lws) to High(lws) do
    if lws[i] = lw then
    begin
      if i <> High(lws) then
        lws[i] := lws[High(lws)];
      l := Length(lws);
      SetLength(lws, l - 1);
      Break;
    end;
end;

procedure DelFromIDArr(var ids: TObjIDArr; Idx: integer);
begin
  if (Idx >= 0) and (Idx <= High(ids)) then
  begin
    if Idx <> High(ids) then
      ids[Idx] := ids[High(ids)];
    Idx := Length(ids);
    SetLength(ids, Idx - 1);
  end;
end;

procedure DelFromHostIDArr(var ids: THostIDArr; Idx: integer); overload;
begin
  if (Idx >= 0) and (Idx <= High(ids)) then
  begin
    if Idx <> High(ids) then
      ids[Idx] := ids[High(ids)];
    Idx := Length(ids);
    SetLength(ids, Idx - 1);
  end;
end;

procedure CombineLWARR(var lws: TLWArr; const p: TLWArr);
var
  i: integer;
begin
  for i := Low(p) to High(p) do
    AddToLWArr(lws, p[i]);
end;

procedure CombineObjGroup(var group: TSerialObjGroup; g1: TSerialObjGroup);
var
  l: integer;
  i: integer;
begin
  l := Length(group);
  SetLength(group, Length(g1) + l);
  for i := Low(g1) to High(g1) do
    group[l + i] := g1[i];
end;

function MakeModuleID(MajorID, MinorID: integer): TID_MODULE;
begin
  Result.MajorID := MajorID;
  Result.MinorID := MinorID;
end;

function MakeObjID(const HostID: TID_HOST; ModuleID: TID_MODULE): TID_OBJ;
begin
  Result.IDDetail.ObjType := OBJTYPE_ENTITY;
  Result.IDDetail.SvrMdl.Svr := 0;
  Result.IDDetail.SvrMdl.HostID := HostID;
  Result.IDDetail.SvrMdl.ModuleID := ModuleID;
end;

function MakeObjID(ObjType, Svr: byte; const HostID: TID_HOST; ModuleID: TID_MODULE): TID_OBJ;
begin
  Result.IDDetail.SvrMdl.HostID := HostID;
  Result.IDDetail.SvrMdl.ModuleID := ModuleID;
  Result.IDDetail.ObjType := ObjType;
  Result.IDDetail.SvrMdl.Svr := Svr;
end;

function MakeDevHistoryID(const hid: TID_HOST): TID_OBJ;
begin
  Result := MakeFixedObjID(hid, L_TAIL_DEVHISTORY);
end;

function MakeRemoteDevID(const hid: TID_HOST): TID_OBJ;
begin
  Result := MakeFixedObjID(hid, L_TAIL_REMOTEDEV);
end;

function MakeLoginObjID(const hid: TID_HOST): TID_OBJ;
begin
  Result := MakeFixedObjID(hid, L_TAIL_LOGINOBJ);
end;

function MakeFixedObjID(const hid: TID_HOST; Tail: word): TID_OBJ;
begin
  Result.IDDetail.ObjType := OBJTYPE_ID;
  Result.IDDetail.SubType := IDSUBTYPE_RECORD;
  Result.IDDetail.SvrMdl.HostID := hid;
  Result.IDDetail.SvrMdl.ModuleID.ModuleID := Tail;
end;

function CombineObjID(const oid: TID_OBJ; mid: TID_MODULE): TID_OBJ;
begin
  Result := oid;
  Result.IDDetail.SvrMdl.ModuleID := mid;
end;

function LocalAuthModule: TID_OBJ;
begin
  Result := CombineObjID(OBJID_LOCALSVR, AUTHMODULE_ID);
end;

function LocalServerModule: TID_OBJ;
begin
  Result := CombineObjID(OBJID_LOCALSVR, SVRMODULE_ID);
end;

function CurrencyToStr(s: CommonString): CommonString;
begin
  Result := WideFormat('%.2f', [StrToInt(s) / 100]);
end;

function StrToCurrency(s: CommonString): CommonString;
begin
  Result := IntToStr(Round((StrToFloat(s) + 0.005) * 100));
end;

procedure AnalyMsgID(msgID: longword; var MajFunc, MinFunc, MsgFunc: byte);
begin
  MajFunc := (msgID and MESID_MAJORFUNC_MASK) shr MESID_MAJORFUNC_SHIFT;
  MinFunc := (msgID and MESID_MINORFUNC_MASK) shr MESID_MINORFUNC_SHIFT;
  MsgFunc := msgID and $FF;
end;

function ObjInGroup(eg: TSerialObjGroup; obj: TSerialObj): longbool;
var
  i: integer;
begin
  Result := False;
  for i := Low(eg) to High(eg) do
    if eg[i] = obj then
    begin
      Result := True;
      Break;
    end;
end;

{ TSerialObj }

procedure TSerialObj.AddObj(obj: TSerialObj);
begin
  AppendItem(obj);
end;

procedure TSerialObj.AppendItem(DDLLI: TDoubleDirLinkListItem; Debug: boolean);
begin
  inherited;
  if DDLLI <> nil then
  begin
    DoSubObjAdded(Self, TSerialObj(DDLLI));
    if (Parent <> nil) and (Parent.InheritsFrom(TSerialObj)) then
      TSerialObj(Parent).DoSubObjAdded(Self, TSerialObj(DDLLI));
    DoModifyed;
  end;
end;

procedure TSerialObj.Assign(Source: TSerialObj; OnlySelf: boolean);
var
  tmp, tmp1: TSerialObj;
begin
  if (Source <> nil) and (Source.ClassID = ClassID) then
  begin
    DoAssign(Source);
    if not OnlySelf then
    begin
      Clear;
      tmp := Source.obj[0];
      while tmp <> nil do
      begin
        tmp1 := TSerialObj(ObjPool.GetObj(tmp.ClassID, Self));
        AddObj(tmp1);
        tmp1.Assign(tmp, OnlySelf);
        tmp := TSerialObj(tmp.Next);
      end;
    end;
    DoModifyed;
  end;
end;

function TSerialObj.CanAddObj(obj: TSerialObj): ERRCODE;
begin
  Result := CanAddSubObj(Self, obj);
  if (Result = ERRCODE_NOERROR) and (Parent <> nil) then
    Result := TSerialObj(Parent).CanAddSubObj(Self, obj);
end;

function TSerialObj.CanAddSubObj(pnt, obj: TSerialObj): ERRCODE;
begin
  Result := ERRCODE_NOERROR;
end;

function TSerialObj.CanDelObj(obj: TSerialObj): ERRCODE;
begin
  Result := CanDelSubObj(Self, obj);
  if (Result = ERRCODE_NOERROR) and (Parent <> nil) then
    Result := TSerialObj(Parent).CanAddSubObj(Self, obj);
end;

function TSerialObj.CanDelSubObj(pnt, obj: TSerialObj): ERRCODE;
begin
  Result := ERRCODE_NOERROR;
end;

function TSerialObj.CheckIsAncent(obj: TSerialObj): longbool;
begin
  Result := CheckIsMyAncent(obj);
end;

procedure TSerialObj.Clear;
begin
  ObjPool.ReturnChildObj(Self, Self);
end;

procedure TSerialObj.ClearItems(FreeItem: boolean);
begin
  inherited;
  DoModifyed;
end;

function TSerialObj.Clone(Recurrence: boolean): TSerialObj;
var
  tmp: TSerialObj;
begin
  Result := TSerialObj(ObjPool.GetObj(ClassID, Self));
  if Result <> nil then
  begin
    {$IFDEF DEBUG}
    if Result.Parent <> nil then
      DbgPrint('Except!!! TSerialObj.Clone Obj %s Parent is not nil', [Result.ClassName], L_DBGLEVEL_CRITICAL);
    {$ENDIF}
    ObjPool.ReturnChildObj(Result, Self);
    DoClone(Result);
    if Recurrence then
    begin
      tmp := obj[0];
      while tmp <> nil do
      begin
        Result.AddObj(tmp.Clone);
        tmp := TSerialObj(tmp.Next);
      end;
    end;
  end;
end;

function TSerialObj.CorrectClassID: longword;
begin
  Result := 0;
end;

procedure TSerialObj.DeleteItem(DDLLI: TDoubleDirLinkListItem; FreeItem: boolean; Debug: boolean);
begin
  if DDLLI <> nil then
  begin
    DoSubObjDeled(Self, TSerialObj(DDLLI));
    if (Parent <> nil) and (Parent.InheritsFrom(TSerialObj)) then
      TSerialObj(Parent).DoSubObjDeled(Self, TSerialObj(DDLLI));
    inherited;
    DoModifyed;
  end;
end;

{$IFDEF UI}

function TSerialObj.NewUIItem(ui: TObject): PUIItem;
var
  i: integer;
begin
  for i := Low(UIItems) to High(UIItems) do
    if UIItems[i].BindUI = ui then
    begin
      Result := @UIItems[i];
      Exit;
    end;
  i := Length(UIItems);
  SetLength(UIItems, i + 1);
  UIItems[i].BindUI := ui;
  UIItems[i].ItmIdx := -1;
  Result := @UIItems[i];
end;

procedure TSerialObj.SetUIItem(ui: TObject; itemvalue: nativeint);
var
  i: integer;
begin
  for i := Low(UIItems) to High(UIItems) do
    if UIItems[i].BindUI = ui then
    begin
      UIItems[i].ItmIdx := itemvalue;
      Break;
    end;
end;

procedure TSerialObj.DelUIItem(ui: TObject);
var
  obj: TSerialObj;
  i: integer;
begin
  for i := Low(UIItems) to High(UIItems) do
    if UIItems[i].BindUI = ui then
    begin
      if i <> High(UIItems) then
        UIItems[i] := UIItems[High(UIItems)];
      SetLength(UIItems, Length(UIItems) - 1);
      Break;
    end;
  obj := TSerialObj(Item[0]);
  while obj <> nil do
  begin
    obj.DelUIItem(ui);
    obj := TSerialObj(obj.Next);
  end;
end;

procedure TSerialObj.ResetUIItems(ui: TObject);
var
  o: TSerialObj;
begin
  SetUIItem(ui);
  o := TSerialObj(Item[0]);
  while o <> nil do
  begin
    o.ResetUIItems(ui);
    o := TSerialObj(o.Next);
  end;
end;

{$ENDIF}

procedure TSerialObj.DelObj(obj: TSerialObj);
begin
  DeleteItem(obj, False);
end;

procedure TSerialObj.DoAssign(Source: TSerialObj);
var
  src: TSerialObj absolute Source;
begin
  FObjID := src.FObjID;
  FCaption := src.FCaption;
end;

procedure TSerialObj.DoClone(Target: TSerialObj);
var
  tgt: TSerialObj absolute Target;
begin
  tgt.FObjID := FObjID;
  tgt.FCaption := FCaption;
end;

procedure TSerialObj.DoDumpObj;
var
  s: CommonString;
begin
  inherited;
  if not FObjID.IsEmpty then
    s := '  ' + S_OBJID + ': ' + FObjID.ToString
  else
    s := '';
  if FCaption <> '' then
  begin
    if s <> '' then
      s := s + ' ' + S_CAPTION + ': ' + FCaption
    else
      s := '  ' + S_CAPTION + ': ' + FCaption;
  end;
  if s <> '' then
    DumpStr(s, []);
end;

procedure TSerialObj.DoModifyed;
begin
  if (Parent <> nil) then
  begin
    {$IFDEF DEBUG}
    if not Parent.InheritsFrom(TSerialObj) then
    begin
      DbgPrint('Except!!! Parent is %s', [Parent.ClassName]);
      DoDumpObj;
    end
    else
    {$ENDIF}
    TSerialObj(Parent).DoModifyed;
  end;
end;

procedure TSerialObj.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    // IDX_CAPTION:
    // ReadUnicodeStringFromPack(Buf, FCaption, Len);
    IDX_OBJID:
      if Len = sizeOf(FObjID) then
        Buf.ReadBuf(FObjID, Len);
    IDX_CAPTIONU8:
      ReadCommonStringFromPack(Buf, FCaption, Len);
    else
      Buf.DataProcessed(Len);
  end;
end;

procedure TSerialObj.DoSubObjAdded(pnt, obj: TSerialObj);
begin

end;

procedure TSerialObj.DoSubObjDeled(pnt, obj: TSerialObj);
begin

end;

procedure TSerialObj.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  WriteCommonStringToPack(dp, IDX_CAPTIONU8, FCaption);
  if not FObjID.IsEmpty then
    WritePropertyToPack(dp, IDX_OBJID, sizeOf(FObjID), FObjID);
end;

function TSerialObj.FindItems(Cap: CommonString): TSerialObjGroup;
var
  tmp: TSerialObj;
  tmpg: TSerialObjGroup;
begin
  SetLength(Result, 0);
  if Cap = Caption then
    AddToObjGroup(Result, Self)
  else
  begin
    tmp := obj[0];
    while tmp <> nil do
    begin
      tmpg := tmp.FindItems(Cap);
      CombineObjGroup(Result, tmpg);
      tmp := TSerialObj(tmp.Next);
    end;
  end;
end;

function TSerialObj.FindItem(const id: TID_OBJ): TSerialObj;
var
  tmp: TSerialObj;
begin
  Result := nil;
  if FObjID = id then
    Result := Self
  else
  begin
    tmp := TSerialObj(Item[0]);
    while tmp <> nil do
    begin
      Result := tmp.FindItem(id);
      if Result <> nil then
        Break;
      tmp := TSerialObj(tmp.Next);
    end;
  end;
end;

function TSerialObj.FindItemLowerLevel(Caption: CommonString): TSerialObj;
begin
  Result := TSerialObj(Item[0]);
  while Result <> nil do
  begin
    if Result.Caption = Caption then
      Break;
    Result := TSerialObj(Result.Next);
  end;
end;

function TSerialObj.FindItemNoMe(const id: TID_OBJ): TSerialObj;
var
  tmp: TSerialObj;
begin
  Result := nil;
  tmp := TSerialObj(Item[0]);
  while tmp <> nil do
  begin
    Result := tmp.FindItem(id);
    if Result <> nil then
      Break;
    tmp := TSerialObj(tmp.Next);
  end;
end;

function TSerialObj.GetObj(Index: integer): TSerialObj;
begin
  Result := TSerialObj(Item[Index]);
end;

function TSerialObj.GetObjByID(const id: TID_OBJ; ObjCls: TSerialObjClass): Pointer;
begin
  Result := TSerialObj(Item[0]);
  while Result <> nil do
  begin
    if TSerialObj(Result).FObjID = id then
      Exit;
    Result := TSerialObj(TSerialObj(Result).Next);
  end;
  Result := ObjPool.GetObj(ObjCls, Self);
  if Result <> nil then
  begin
    TSerialObj(Result).FObjID := id;
    AppendItem(TSerialObj(Result));
  end;
end;

function TSerialObj.GetObjByName(Cap: CommonString; ObjCls: TSerialObjClass): Pointer;
begin
  Result := TSerialObj(Item[0]);
  while Result <> nil do
  begin
    if TSerialObj(Result).FCaption = Cap then
      Exit;
    Result := TSerialObj(TSerialObj(Result).Next);
  end;
  Result := ObjPool.GetObj(ObjCls, Self);
  if Result <> nil then
  begin
    TSerialObj(Result).FCaption := Cap;
    AppendItem(TSerialObj(Result));
  end;
end;

function TSerialObj.GetParamByID(ClassID: longword): TSerialObj;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
  begin
    Result := obj[i];
    if Result.ClassID = ClassID then
      Exit;
  end;
  Result := nil;
end;

procedure TSerialObj.InsertItem(DDLLI, Index: TDoubleDirLinkListItem);
begin
  inherited;
  if DDLLI <> nil then
  begin
    // {$IFDEF UI}
    // TSerialObj(DDLLI).SetUIItems(Length(UIItems));
    // {$ENDIF}
    DoSubObjAdded(Self, TSerialObj(DDLLI));
    if (Parent <> nil) and (Parent.InheritsFrom(TSerialObj)) then
      TSerialObj(Parent).DoSubObjAdded(Self, TSerialObj(DDLLI));
    DoModifyed;
  end;
end;

procedure TSerialObj.InsertObj(obj, Idx: TSerialObj);
begin
  InsertItem(obj, Idx);
end;

class function TSerialObj.LoadFromPack(dp: TIOCPDataCollecter): TSerialObj;
var
  d: longword;
begin
  Result := nil;
  if dp <> nil then
  begin
    if dp.PackCapacity = 0 then
      dp.PackCapacity := dp.DataCapacity;
    d := 0;
    dp.ReadBuf(d, sizeOf(d));
    if d = OBJFLAG_CLASSID then
    begin
      d := 0;
      dp.ReadBuf(d, sizeOf(d));
      Result := TSerialObj(ObjPool.GetObj(d, nil));
      if Result <> nil then
        Result.ReadFromPack(dp);
    end;
  end;
end;

procedure TSerialObj.MaintainObjID;
var
  o: TSerialObj;
begin
  if FObjID.IsEmpty then
    FObjID.GenericID(OBJTYPE_ID);
  o := TSerialObj(Item[0]);
  while o <> nil do
  begin
    o.MaintainObjID;
    o := TSerialObj(o.Next);
  end;
end;

procedure TSerialObj.Merge(List: TSerialObj);
var
  t1, t2: TSerialObj;
begin
  if List <> nil then
  begin
    while List.Count > 0 do
    begin
      t1 := List.obj[0];
      t2 := FindItemLowerLevel(t1.ObjID);
      if t2 <> nil then
      begin
        t2.Merge(t1);
        ObjPool.ReturnObj(t1, Self);
      end
      else
        AddObj(t1);
    end;
    Assign(List);
    ObjPool.ReturnObj(List, Self);
  end;
end;

procedure TSerialObj.MoveItem(DDLLI: TDoubleDirLinkListItem; Offset: integer);
begin
  inherited;
  DoModifyed;
end;

procedure TSerialObj.MoveObj(obj, Idx: TSerialObj);
begin
  if (obj <> nil) and (Idx <> nil) and (obj <> Idx) then
  begin
    DeleteItem(obj, False);
    InsertItem(obj, Idx);
  end;
end;

function TSerialObj.MultiIDs(Idx: integer; var id: PID_OBJ): boolean;
begin
  if Idx = 0 then
  begin
    Result := True;
    id := @FObjID;
  end
  else
    Result := False;
end;

procedure TSerialObj.ReadAnsiStringFromPack(dp: TIOCPDataCollecter; var s: ansistring; Len: integer);
begin
  if Len > 0 then
  begin
    SetLength(s, Len - 1);
    dp.ReadBuf(s[1], Len);
  end
  else
    s := '';
end;

procedure TSerialObj.ReadFromPack(dp: TIOCPDataCollecter);
var
  ObjFlag, Idx, Len: longword;
  tmp: TSerialObj;
begin
  try
    while dp.DataCapacity >= sizeOf(longword) do
    begin
      ObjFlag := dp.ReadLSB;
      case ObjFlag of
        OBJFLAG_CLASSID_LSB:
        begin
          Idx := dp.ReadLSB;
          tmp := ObjPool.GetObj(Idx, Self);
          if tmp = nil then
          begin
            tmp := ObjPool.GetObj(TDefaultObj, Self);
            TDefaultObj(tmp).FRealClassID := Idx;
          end;
          if tmp <> nil then
          begin
            tmp.ReadFromPack(dp);
            AddObj(tmp);
          end
          else
            Break;
        end;
        OBJFLAG_PROPERTY_LSB:
        begin
          Idx := dp.ReadLSB;
          Len := dp.ReadLSB;
          if Len < dp.PackCapacity then
            DoReadFromPack(Idx, Len, dp)
          else
            Break;
        end;
        OBJFLAG_END_LSB:
          Break;
        else
          Break;
      end;
    end;
  except

  end;
end;

procedure TSerialObj.ReadUnicodeStringFromPack(dp: TIOCPDataCollecter; var s: unicodestring; Len: integer);
begin
  if Len > 0 then
  begin
    SetLength(s, Len div 2 - 1);
    dp.ReadBuf(s[1], Len);
  end
  else
    s := '';
end;

procedure TSerialObj.ReadCommonStringFromPack(dp: TIOCPDataCollecter; var s: CommonString; Len: integer);
var
  u8s: rawbytestring;
begin
  if Len > 0 then
  begin
    SetLength(u8s, Len);
    dp.ReadBuf(u8s[1], Len);
    {$IFDEF FPC}
    s := CommonString(PAnsiChar(u8s));
    {$ELSE}
    s := UTF8StrToUnicode(u8s); // UTF8ToUnicodeString(u8s);
    {$ENDIF}
  end
  else
    s := '';
end;

procedure TSerialObj.Return;
begin
  inherited;
  FObjID.Empty;
  FCaption := '';
  {$IFDEF UI}
  SetLength(UIItems, 0);
  {$ENDIF}
end;

procedure TSerialObj.SetCaption(const Value: CommonString);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    DoModifyed;
  end;
end;

procedure TSerialObj.SetObjID(const Value: TID_OBJ);
begin
  if FObjID <> Value then
  begin
    FObjID := Value;
    DoModifyed;
  end;
end;

procedure TSerialObj.WriteAnsiStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: ansistring);
var
  Len: longword;
begin
  if s <> '' then
  begin
    Len := (Length(s) + 1);
    WritePropertyToPack(dp, Idx, Len, s[1]);
  end;
end;

procedure TSerialObj.WriteCombinePropertyToPack(dp: TIOCPDataCollecter; Idx: longword;
  const CombineProperty: TCOMBINE_PROPERTY_INFOS);
var
  tmpL: longword;
  i: integer;
begin
  tmpL := OBJFLAG_PROPERTY;
  dp.WriteBuf(tmpL, sizeOf(tmpL));
  dp.WriteBuf(Idx, sizeOf(Idx));
  tmpL := 0;
  for i := 0 to CombineProperty.Count - 1 do
    Inc(tmpL, CombineProperty.Infos[i].Len);
  dp.WriteBuf(tmpL, sizeOf(tmpL));
  for i := 0 to CombineProperty.Count - 1 do
    dp.WriteBuf(CombineProperty.Infos[i].Buf^, CombineProperty.Infos[i].Len);
end;

procedure TSerialObj.WriteSize4ComboProperty(dp: TIOCPDataCollecter; Idx: longword; Propertys: array of longword);
var
  i: integer;
begin
  if Length(Propertys) > 0 then
  begin
    dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
    dp.WriteLSB(Idx);
    i := Length(Propertys) * 4;
    dp.WriteLSB(i);
    dp.WriteBuf(Propertys[0], i);
  end;
end;

procedure TSerialObj.WriteSize8ComboProperty(dp: TIOCPDataCollecter; Idx: longword; Propertys: array of Pointer);
var
  i: integer;
begin
  if Length(Propertys) > 0 then
  begin
    dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
    dp.WriteLSB(Idx);
    dp.WriteLSB(Length(Propertys));
    for i := Low(Propertys) to High(Propertys) do
      dp.WriteBuf(Propertys[i]^, 8);
  end;
end;

procedure TSerialObj.WritePropertyHeaderToPack(dp: TIOCPDataCollecter; Idx, Len: longword);
begin
  dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
  dp.WriteLSB(Idx);
  dp.WriteLSB(Len);
end;

procedure TSerialObj.WritePropertyLSBToPack(dp: TIOCPDataCollecter; Idx, LSB: longword);
begin
  dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
  dp.WriteLSB(Idx);
  dp.WriteLSB(4);
  dp.WriteLSB(LSB);
end;

procedure TSerialObj.WritePropertyToPack(dp: TIOCPDataCollecter; Idx, Len: longword; const Buf);
begin
  dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
  dp.WriteLSB(Idx);
  dp.WriteLSB(Len);
  dp.WriteBuf(Buf, Len);
end;

procedure TSerialObj.WriteToPack(dp: TIOCPDataCollecter);
var
  tmpL: longword;
  tmp: TSerialObj;
begin
  dp.WriteLSB(OBJFLAG_CLASSID_LSB);
  tmpL := CorrectClassID;
  if tmpL = 0 then
    tmpL := ClassID;
  dp.WriteLSB(tmpL);
  DoWritePropertyToPack(dp);
  tmp := obj[0];
  while tmp <> nil do
  begin
    tmp.WriteToPack(dp);
    tmp := TSerialObj(tmp.Next);
  end;
  dp.WriteLSB(OBJFLAG_END_LSB);
end;

procedure TSerialObj.WriteUnicodeStringPropertysToPack(dp: TIOCPDataCollecter; Idx: longword; strs: array of const);
var
  i: integer;
begin
  for i := 0 to High(strs) do
    if strs[i].VType = vtUnicodeString then
    begin
      WriteUnicodeStringToPack(dp, Idx, CommonString(strs[i].VUnicodeString));
      Inc(Idx);
    end;
end;

procedure TSerialObj.ReadIntArrFromPack(dp: TIOCPDataCollecter; var s: TIntArr; Len: integer);
begin
  if (Len > 0) and (Len mod SizeOf(integer) = 0) then
  begin
    SetLength(s, Len div SizeOf(integer));
    dp.ReadBuf(s[0], len);
  end;
end;

procedure TSerialObj.WriteIntArrToPack(dp: TIOCPDataCollecter; Idx: longword; const s: TIntArr);
begin
  if Length(s) > 0 then
    WritePropertyToPack(dp, idx, Length(s) * SizeOf(integer), s[0]);
end;

procedure TSerialObj.WriteUnicodeStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: unicodestring);
var
  Len: longword;
begin
  if s <> '' then
  begin
    Len := (Length(s) + 1) * 2;
    WritePropertyToPack(dp, Idx, Len, s[1]);
  end;
end;

procedure TSerialObj.WriteCommonStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: CommonString; Force: boolean);
var
  u8s: ansistring;
begin
  if (s <> '') or Force then
  begin
    {$IFNDEF FPC}
    u8s := UnicodeStrToUTF8(s);
    WritePropertyToPack(dp, Idx, Length(u8s) + 1, u8s[1]);
    {$ELSE}
    //u8s := ansistring(s);
    WritePropertyToPack(dp, Idx, Length(s) + 1, s[1]);
    {$ENDIF}
  end;
end;

procedure TSerialObj.ForceWriteUnicodeStringToPack(dp: TIOCPDataCollecter; Idx: longword; s: CommonString);
var
  Len: longword;
  Buf: pansichar;
begin
  if s <> '' then
  begin
    Len := (Length(s) + 1) * 2;
    Buf := @s[1];
  end
  else
  begin
    Len := 0;
    Buf := nil;
  end;
  WritePropertyToPack(dp, Idx, Len, Buf^);
end;

{ TSerialFile }

procedure TSerialFile.DoAssign(Source: TSerialObj);
var
  src: TSerialFile absolute Source;
begin
  inherited;
end;

procedure TSerialFile.DoClone(Target: TSerialObj);
var
  tgt: TSerialFile absolute Target;
begin
  inherited;
end;

procedure TSerialFile.DoFileLoaded;
begin

end;

procedure TSerialFile.DoModifyed;
begin
  FModifyed := True;
  // inherited;
end;

procedure TSerialFile.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
begin
  inherited;
end;

procedure TSerialFile.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  inherited;
end;

function TSerialFile.GetStoreList(const id: TID_OBJ): TStoreList;
begin
  Result := TStoreList(GetObjByID(id, TStoreList));
end;

function TSerialFile.InitTable(const id: TID_OBJ; Name: CommonString; cls: TSerialObjClass): Pointer;
begin
  if (Count = 0) and (FStoreFileName <> '') then
    ReadFromFile;
  Result := GetObjByID(id, cls);
  if TSerialObj(Result).Caption = '' then
    TSerialObj(Result).Caption := Name;
end;

class function TSerialFile.LoadFromFile(FileName: CommonString): TSerialFile;
var
  h: THandle;
  dp: TIOCPDataCollecter;
  d: TIOCPData;
  Len, r: longword;
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
begin
  dp := nil;
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    dp := TIOCPDataCollecter(ObjPool.GetObj(TIOCPDataCollecter, nil));
    if dp <> nil then
    begin
      Len := FileSeek(h, 0, 2);
      FileSeek(h, 0, 0);
      // {$IFDEF LINUX}
      // if fpstat(FileName, st) = 0 then
      // Len := st.st_size
      // else
      // Len := 0;
      // {$ENDIF}
      dp.PackCapacity := Len;
      while Len > 0 do
      begin
        d := TIOCPData(ObjPool.GetObj(TIOCPData, nil));
        if d <> nil then
        begin
          dp.AddData(d);
          r := FileRead(h, d.IdleBuf^, d.IdleSize);
          d.PutData(r);
          Dec(Len, r);
          if r = 0 then
            Break;
        end
        else
          Break;
      end;
    end;
    FileClose(h);
  end;
  Result := nil;
  if h <> INVALID_HANDLE_VALUE then
  begin
    if dp <> nil then
    begin
      dp.ReadBuf(Len, sizeOf(Len));
      if Len = OBJFLAG_CLASSID then
      begin
        dp.ReadBuf(Len, sizeOf(Len));
        Result := TSerialFile(ObjPool.GetObj(Len, nil));
        if Result <> nil then
        begin
          Result.ReadFromPack(dp);
          Result.FModifyed := False;
        end;
      end;
      ObjPool.ReturnObj(dp, nil);
    end;
  end;
end;

procedure TSerialFile.MaintainIDs;
var
  o: TSerialObj;
begin
  o := TSerialObj(Item[0]);
  while o <> nil do
  begin
    o.MaintainObjID;
    o := TSerialObj(o.Next);
  end;
end;

function TSerialFile.ReadFileData(FileName: CommonString): TIOCPDataCollecter;
var
  h: THandle;
  Len, r: longword;
  d: TIOCPData;
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
begin
  Result := nil;
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    Result := ObjPool.GetObj(TIOCPDataCollecter, Self);
    if Result <> nil then
    begin
      Len := FileSeek(h, 0, 2);
      FileSeek(h, 0, 0);
      // {$IFDEF LINUX}
      // if fpstat(FileName, st) = 0 then
      // Len := st.st_size
      // else
      // Len := 0;
      // {$ENDIF}
      Result.PackCapacity := Len;
      while Len > 0 do
      begin
        d := TIOCPData(ObjPool.GetObj(TIOCPData, Self));
        if d <> nil then
        begin
          Result.AddData(d);
          r := FileRead(h, d.IdleBuf^, d.IdleSize);
          d.PutData(r);
          Dec(Len, r);
          if r = 0 then
            Break;
        end
        else
          Break;
      end;
    end;
    FileClose(h);
  end;
end;

procedure TSerialFile.ReadFromFile(FileName: CommonString);
var
  dp: TIOCPDataCollecter;
  F: THandle;
  Len: longword;
begin
  if FileName = '' then
    FileName := FStoreFileName
  else
    FStoreFileName := FileName;
  ClearItems;
  if FDirectFileAccess then
  begin
    F := FileOpen(FileName, fmOpenRead);
    if F <> INVALID_HANDLE_VALUE then
    begin
      dp := ObjPool.GetObj(TIOCPDataCollecter, Self);
      dp.FileHandle := F;
      Len := dp.ReadLSB;
      if Len = OBJFLAG_CLASSID_LSB then
      begin
        dp.ReadLSB;
        ReadFromPack(dp);
      end;
      ObjPool.ReturnObj(dp, Self);
      FileClose(F);
    end;
  end
  else
  begin
    dp := ReadFileData(FileName);
    if dp <> nil then
    begin
      Len := dp.ReadLSB;
      if Len = OBJFLAG_CLASSID_LSB then
      begin
        dp.ReadLSB;
        ReadFromPack(dp);
      end;
      ObjPool.ReturnObj(dp, Self);
    end;
    TranslateID;
  end;
  DoFileLoaded;
  FModifyed := False;
end;

procedure TSerialFile.SetModifyed(Value: boolean);
begin
  FModifyed := Value;
end;

procedure TSerialFile.TranslateID;
var
  t: TSerialObj;
  id: TID_OBJ;

  procedure ReplaceRecordSubType(s: TSerialObj);
  var
    tmp: TSerialObj;
  begin
    tmp := TSerialObj(s.Item[0]);
    while tmp <> nil do
    begin
      id := tmp.ObjID;
      id.IDDetail.SubType := IDSUBTYPE_RECORD;
      tmp.ObjID := id;
      tmp := TSerialObj(tmp.Next);
    end;
  end;

begin
  t := TSerialObj(Item[0]);
  while t <> nil do
  begin
    if t.IsInherited(CLASSID_DATATABLE) then
    begin
      id := t.ObjID;
      if id.IDDetail.SubType <> 0 then
      begin
        id.IDDetail.SubType := IDSUBTYPE_TABLE;
        t.ObjID := id;
        // ReplaceRecordSubType(t);
      end;
    end;
    t := TSerialObj(t.Next);
  end;
end;

procedure TSerialFile.WriteDataToFile(FileName: CommonString; dp: TIOCPDataCollecter);
var
  h: THandle;
  d: TIOCPData;
  r: longword;
begin
  if dp <> nil then
  begin
    h := FileCreate(FileName, fmOpenWrite);
    if h <> INVALID_HANDLE_VALUE then
    begin
      while dp.Count > 0 do
      begin
        d := dp.Data[0];
        r := FileWrite(h, d.Buf^, d.BufCapacity);
        if r > 0 then
          dp.DataProcessed(r)
        else
          Break;
      end;
      FileClose(h);
    end;
  end;
end;

procedure TSerialFile.WriteToFile(FileName: CommonString; Force: boolean);
var
  dp: TIOCPDataCollecter;
  F: THandle;
begin
  if Force or FModifyed then
  begin
    if FileName = '' then
      FileName := FStoreFileName;
    if FDirectFileAccess then
    begin
      F := FileCreate(FileName);
      if F <> INVALID_HANDLE_VALUE then
      begin
        dp := TIOCPDataCollecter(ObjPool.GetObj(TIOCPDataCollecter, Self));
        if dp <> nil then
        begin
          dp.FileHandle := F;
          WriteToPack(dp);
          // WriteDataToFile(FileName, dp);
          ObjPool.ReturnObj(dp, Self);
        end;
        FileClose(F);
      end;
    end
    else
    begin
      dp := TIOCPDataCollecter(ObjPool.GetObj(TIOCPDataCollecter, Self));
      if dp <> nil then
      begin
        WriteToPack(dp);
        WriteDataToFile(FileName, dp);
        ObjPool.ReturnObj(dp, Self);
      end;
    end;
    FModifyed := False;
  end;
end;

function TSerialObj.FilteItems(Cap: CommonString): TSerialObjGroup;
var
  tmp: TSerialObj;
  tmpg: TSerialObjGroup;
begin
  SetLength(Result, 0);
  if Pos(Cap, Caption) <> 0 then
    AddToObjGroup(Result, Self)
  else
  begin
    tmp := TSerialObj(Item[0]);
    while tmp <> nil do
    begin
      tmpg := tmp.FindItems(Cap);
      CombineObjGroup(Result, tmpg);
      tmp := TSerialObj(tmp.Next);
    end;
  end;
end;

function TSerialObj.FindItemLowerLevel(const id: TID_OBJ): TSerialObj;
begin
  Result := TSerialObj(Item[0]);
  while Result <> nil do
  begin
    if Result.FObjID = id then
      Break;
    Result := TSerialObj(Result.Next);
  end;
end;

{$IFDEF UI}

function TSerialObj.UIItemCount: integer;
begin
  Result := Length(UIItems);
end;

{$ENDIF}

function TSerialObj.Update(obj: TSerialObj): TSerialObj;
var
  tl: TSerialObj;
begin
  if obj <> nil then
  begin
    Result := obj;
    tl := FindItemLowerLevel(obj.ObjID);
    if tl = nil then
      AppendItem(obj)
    else
    begin
      Result := tl;
      tl.DoAssign(obj);
      while obj.Count > 0 do
        tl.Update(obj.obj[0]);
      ObjPool.ReturnObj(obj, Self);
    end;
  end
  else
    Result := nil;
end;

{ TFuncInfo }

class function TFuncInfo.ClassID: longword;
begin
  Result := CLASSID_FUNCTION_INFO;
end;

function TFuncInfo.GetFuncDesc: CommonString;
begin
  Result := Caption;
end;

procedure TFuncInfo.SetFuncDesc(const Value: CommonString);
begin
  Caption := Value;
end;

{ TStringObj }

class function TStringObj.ClassID: longword;
begin
  Result := CLASSID_STRINGOBJ;
end;

procedure TStringObj.DoAssign(Source: TSerialObj);
var
  src: TStringObj absolute Source;
begin
  inherited;
  FStr := src.FStr;
  FFlag := src.FFlag;
  FData := src.FData;
end;

procedure TStringObj.DoClone(Target: TSerialObj);
var
  tgt: TStringObj absolute Target;
begin
  inherited;
  tgt.FStr := FStr;
  tgt.FFlag := FFlag;
  tgt.FData := FData;
end;

procedure TStringObj.DoDumpObj;
begin
  inherited;
  DumpStr('  Str: %s, Flag: %d', [FStr, FFlag]);
end;

procedure TStringObj.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    // 1:
    // ReadUnicodeStringFromPack(Buf, FStr, Len);
    2:
      Buf.ReadBuf(FFlag, Len);
    3:
      ReadCommonStringFromPack(Buf, FStr, Len);
    else
      inherited;
  end;
end;

procedure TStringObj.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  inherited;
  if FFlag <> 0 then
    WritePropertyToPack(dp, 2, sizeOf(FFlag), FFlag);
  WriteCommonStringToPack(dp, 3, FStr);
end;

procedure TStringObj.Return;
begin
  inherited;
  FStr := '';
  FData := nil;
  FFlag := 0;
end;

procedure TStringObj.SetFlag(const Value: longword);
begin
  if FFlag <> Value then
  begin
    FFlag := Value;
    DoModifyed;
  end;
end;

procedure TStringObj.SetStr(const Value: CommonString);
begin
  if FStr <> Value then
  begin
    FStr := Value;
    DoModifyed;
  end;
end;

{ TStoreList }

procedure TStoreList.AddRdDeled(tu: TOnRecordDeled);
begin
  AddInNotifyArr(FRecordDeled, TEventNotify(tu));
end;

procedure TStoreList.AddRdUpdated(tu: TOnRecordUpdated);
begin
  AddInNotifyArr(FRecordUpdated, TEventNotify(tu));
end;

procedure TStoreList.AddTblUpdated(tu: TOnTableUpdated);
begin
  AddInNotifyArr(FTableUpdated, TEventNotify(tu));
end;

class function TStoreList.ClassID: longword;
begin
  Result := CLASSID_DATATABLE;
end;

function TStoreList.DelObj(const id: TID_OBJ; const sid, uid: TID_OBJ): ERRCODE;
var
  o: TSerialObj;
begin
  Result := ERRCODE_NOERROR;
  o := FindItemNoMe(id);
  if (o <> nil) then
  begin
    if Assigned(FCanDelObj) then
      Result := FCanDelObj(o, sid, uid);
    if Result = ERRCODE_NOERROR then
    begin
      NotifyRecordDeled(o, sid, uid);
      ObjPool.ReturnObj(o, Self);
      Result := ERRCODE_NOERROR;
    end;
  end
  else
    Result := ERRCODE_OBJNOTEXIST;
  FLastError := Result;
end;

procedure TStoreList.DelRdDeled(tu: TOnRecordDeled);
begin
  DelFromNotifyArr(FRecordDeled, TEventNotify(tu));
end;

procedure TStoreList.DelRdUpdated(tu: TOnRecordUpdated);
begin
  DelFromNotifyArr(FRecordUpdated, TEventNotify(tu));
end;

procedure TStoreList.DelTblUpdated(tu: TOnTableUpdated);
begin
  DelFromNotifyArr(FTableUpdated, TEventNotify(tu));
end;

function TStoreList.GetOrNewObj(sertype: TSerialObjClass): TSerialObj;
begin
  Result := Param(sertype);
  if (Result = nil) and (sertype <> nil) then
  begin
    Result := ObjPool.GetObj(sertype, Self);
    AppendItem(Result);
  end;
end;

procedure TStoreList.NotifyRecordDeled(obj: TSerialObj; const sid, uid: TID_OBJ);
var
  i: integer;
begin
  for i := Low(FRecordDeled) to High(FRecordDeled) do
    TOnRecordDeled(FRecordDeled[i])(Self, obj, sid, uid);
end;

procedure TStoreList.NotifyRecordUpdated;
var
  i: integer;
begin
  if Length(FRecordUpdated) > 0 then
    for i := Low(FRecordUpdated) to High(FRecordUpdated) do
      TOnRecordUpdated(FRecordUpdated[i])(Self, ParObj, obj, sid, uid);
end;

procedure TStoreList.NotifyTableUpdated(const sid, uid: TID_OBJ);
var
  i: integer;
begin
  if Length(FTableUpdated) > 0 then
    for i := Low(FTableUpdated) to High(FTableUpdated) do
      TOnTableUpdated(FTableUpdated[i])(Self)
  else if Length(FRecordUpdated) > 0 then
    RescureRecordUpdated(Self, sid, uid);
end;

function TStoreList.RegedEventNotifyCount: integer;
begin
  Result := Length(FRecordUpdated) + Length(FTableUpdated) + Length(FRecordDeled);
end;

procedure TStoreList.RescureRecordUpdated(obj: TSerialObj; const sid, uid: TID_OBJ);
var
  tmp: TSerialObj;
begin
  tmp := TSerialObj(obj.Item[0]);
  while tmp <> nil do
  begin
    NotifyRecordUpdated(obj, tmp, sid, uid);
    RescureRecordUpdated(tmp, sid, uid);
    tmp := TSerialObj(tmp.Next);
  end;
end;

procedure TStoreList.Return;
begin
  inherited;
  FAllowSameName := False;
  FLastError := 0;
  FCanAddObj := nil;
  FCanDelObj := nil;
  // FObjAdded := nil;
  FGetRecords := nil;
  SetLength(FRecordUpdated, 0);
  SetLength(FTableUpdated, 0);
  SetLength(FRecordDeled, 0);
end;

procedure TStoreList.SetAllowSameName(const Value: boolean);
begin
  if FAllowSameName <> Value then
  begin
    FAllowSameName := Value;
    DoModifyed;
  end;
end;

procedure TStoreList.SetLastErrcode(ec: ERRCODE);
begin
  FLastError := ec;
end;

procedure TStoreList.SetLastError(e: ERRCODE);
begin
  FLastError := e;
end;

function TStoreList.UpdateObj(const pnt: TID_OBJ; obj: TSerialObj; const sid, uid: TID_OBJ): TSerialObj;
var
  po, eo, co: TSerialObj;
begin
  if obj.Parent = Self then
  begin
    FLastError := ERRCODE_NOERROR;
    Result := obj;
    Exit;
  end;
  Result := nil;
  if not pnt.IsEmpty then
  begin
    po := FindItem(pnt);
    if po = nil then
    begin
      FLastError := ERRCODE_OBJNOTEXIST;
      Result := obj;
      Exit;
    end;
  end
  else
    po := Self;
  FLastError := ERRCODE_NOERROR;
  if obj <> nil then
  begin
    Result := obj;
    if obj.ObjID.IsEmpty then
      eo := nil
    else
      eo := po.FindItemNoMe(obj.ObjID);
    if not FAllowSameName then
    begin
      co := TSerialObj(po.Item[0]);
      while co <> nil do
      begin
        if (co <> eo) and (obj.Caption = co.Caption) then
        begin
          FLastError := ERRCODE_SAMENAMEEXIST;
          Exit;
        end;
        co := TSerialObj(co.Next);
      end;
    end;
    if Assigned(FCanAddObj) then
      FLastError := FCanAddObj(po, sid, uid, obj, eo);
    if (FLastError = ERRCODE_NOERROR) and (obj <> nil) then
    begin
      if obj.ObjID.IsEmpty or (eo = nil) then
      begin
        if obj.ObjID.IsEmpty then
          obj.ObjID.GenericID(OBJTYPE_ID, IDSUBTYPE_RECORD);
        po.AddObj(obj);
        Result := obj;
      end
      else
      begin
        if eo <> obj then
        begin
          eo.Assign(obj);
          ObjPool.ReturnObj(obj, Self);
          Result := eo;
        end
        else
          Result := obj;
      end;
      NotifyRecordUpdated(po, Result, sid, uid);
    end;
  end;
end;

{ TFileContent }

class function TFileContent.ClassID: longword;
begin
  Result := CLASSID_FILECONTENT;
end;

procedure TFileContent.DoAssign(Source: TSerialObj);
var
  src: TFileContent absolute Source;
begin
  inherited;
end;

procedure TFileContent.DoClone(Target: TSerialObj);
var
  tgt: TFileContent absolute Target;
begin
  inherited;
end;

procedure TFileContent.SaveToTempFile(Buf: TIOCPDataCollecter; Len: longword);
var
  s: CommonString;
  h: THandle;
  d: TIOCPData;
  r: longword;
begin
  s := ObjPool.TempPath + ObjID.ToString;
  h := FileCreate(s, fmOpenWrite);
  if h <> INVALID_HANDLE_VALUE then
  begin
    while Len > 0 do
    begin
      d := Buf.Data[0];
      r := d.BufCapacity;
      if r > Len then
        r := Len;
      r := FileWrite(h, d.Buf^, r);
      Buf.DataProcessed(r);
      Dec(Len, r);
    end;
    {$IFDEF MSWINDOWS}
    if FileSetDate(h, FFileModTime) <> 0 then
      DbgPrint('FileSetDate fault: %s', [SysErrorMessage(GetLastError)], L_DBGLEVEL_CRITICAL);
    FileClose(h);
    {$ELSE}
    FileClose(h);
    SetFileModTime(s, FFileModTime);
    {$ENDIF}
  end
  else
    DbgPrint('Save temp file error : %s', [SysErrorMessage(
      {$IFDEF MSWINDOWS}
      GetLastError
      {$ELSE}
errno
      {$ENDIF}
      )]);
  FileName := s;
end;

procedure TFileContent.SetFileName(const Value: CommonString);
begin
  Caption := Value;
end;

procedure TFileContent.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
var
  ft: TFILETIME;
begin
  case PropertyIdx of
    2:
      SaveToTempFile(Buf, Len);
    3:
    begin
      Buf.ReadBuf(ft, Len);
      FFileModTime := FileTimeToFileDate(ft);
    end;
    4:
      Buf.ReadBuf(FFileModTime, Len);
    else
      inherited;
  end;
end;

procedure TFileContent.DoWritePropertyToPack(dp: TIOCPDataCollecter);
var
  h: THandle;
  Len: TFILE_SIZE;
  tmpL, r: longword;
  d: TIOCPData;
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
begin
  inherited;
  {$IFDEF LINUX}
  if fpstat(FileName, st) = 0 then
  begin
    PInt64(@FFileModTime)^ := st.st_mtime;
    Len.fp64 := st.st_size;
  end
  else
    Len.fp64 := 0;
  {$ENDIF}
  h := FileOpen(FileName, fmOpenRead);
  FileName := '';
  if h <> INVALID_HANDLE_VALUE then
  begin
    {$IFDEF MSWINDOWS}
    FFileModTime := FileGetDate(h);
    WritePropertyToPack(dp, 4, sizeOf(FFileModTime), FFileModTime);
    Len.fp64 := FileSeek(h, int64(0), 2);
    FileSeek(h, 0, 0);
    {$ENDIF}
    dp.WriteLSB(OBJFLAG_PROPERTY_LSB);
    dp.WriteLSB(2);
    dp.WriteLSB(Len.fpLow);
    while Len.fpLow > 0 do
    begin
      d := dp.Data[dp.Count - 1];
      if (d = nil) or (d.IdleSize = 0) or ((dp.PackLimit.LenPerPack <> 0) and
        (dp.PackLimit.LenPerPack - d.BufCapacity = 0)) then
      begin
        d := TIOCPData(ObjPool.GetObj(TIOCPData, Self));
        dp.AddData(d);
        d.PutData(dp.PackLimit.ReservedLen);
      end;
      tmpL := Len.fpLow;
      if dp.PackLimit.LenPerPack <> 0 then
      begin
        if tmpL > dp.PackLimit.LenPerPack - d.BufCapacity then
          tmpL := dp.PackLimit.LenPerPack - d.BufCapacity;
      end
      else if tmpL > d.IdleSize then
        tmpL := d.IdleSize;
      r := FileRead(h, d.IdleBuf^, tmpL);
      d.PutData(r);
      Dec(Len.fpLow, r);
    end;
    FileClose(h);
  end;
end;

function TFileContent.GetFileName: CommonString;
begin
  Result := Caption;
end;

procedure TFileContent.Return;
begin
  inherited;
  FFileModTime := 0;
end;

{ TStubObj }

class function TStubObj.ClassID: longword;
begin
  Result := CLASSID_STUBOBJ;
end;

procedure TStubObj.Return;
begin
  inherited;
  FRealObj := nil;
end;

{ TDefaultObj }

class function TDefaultObj.ClassID: longword;
begin
  Result := CLASSID_DEFAULTOBJ;
end;

function TDefaultObj.CorrectClassID: longword;
begin
  Result := FRealClassID;
end;

procedure TDefaultObj.DoAssign(Source: TSerialObj);
var
  src: TDefaultObj absolute Source;
  i: integer;
begin
  inherited;
  SetLength(FPropertys, Length(src.FPropertys));
  for i := Low(src.FPropertys) to High(src.FPropertys) do
  begin
    FPropertys[i].id := src.FPropertys[i].id;
    FPropertys[i].BufLen := src.FPropertys[i].BufLen;
    if src.FPropertys[i].BufLen > sizeOf(int64) then
    begin
      GetMem(FPropertys[i].pBuf, FPropertys[i].BufLen);
      Move(src.FPropertys[i].pBuf^, FPropertys[i].pBuf^, FPropertys[i].BufLen);
    end
    else
      FPropertys[i].fBuf := src.FPropertys[i].fBuf;
  end;
end;

procedure TDefaultObj.DoClone(Target: TSerialObj);
var
  tgt: TDefaultObj absolute Target;
  i: integer;
begin
  inherited;
  SetLength(tgt.FPropertys, Length(FPropertys));
  for i := Low(FPropertys) to High(FPropertys) do
  begin
    tgt.FPropertys[i].id := FPropertys[i].id;
    tgt.FPropertys[i].BufLen := FPropertys[i].BufLen;
    if FPropertys[i].BufLen > sizeOf(int64) then
    begin
      GetMem(tgt.FPropertys[i].pBuf, FPropertys[i].BufLen);
      Move(FPropertys[i].pBuf^, tgt.FPropertys[i].pBuf^, FPropertys[i].BufLen);
    end
    else
      tgt.FPropertys[i].fBuf := FPropertys[i].fBuf;
  end;
end;

procedure TDefaultObj.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
var
  l: integer;
  p: Pointer;
begin
  if PropertyIdx in [IDX_SERIALLOW .. IDX_SERIALHIGH] then
    inherited
  else
  begin
    l := Length(FPropertys);
    SetLength(FPropertys, l + 1);
    FPropertys[l].id := PropertyIdx;
    FPropertys[l].BufLen := Len;
    if Len > sizeOf(int64) then
    begin
      GetMem(FPropertys[l].pBuf, Len);
      p := FPropertys[l].pBuf;
    end
    else
      p := @FPropertys[l].fBuf;
    Buf.ReadBuf(p^, Len);
  end;
end;

procedure TDefaultObj.DoWritePropertyToPack(dp: TIOCPDataCollecter);
var
  i: integer;
  p: Pointer;
begin
  inherited;
  for i := Low(FPropertys) to High(FPropertys) do
  begin
    if FPropertys[i].BufLen > sizeOf(int64) then
      p := FPropertys[i].pBuf
    else
      p := @FPropertys[i].fBuf;
    WritePropertyToPack(dp, FPropertys[i].id, FPropertys[i].BufLen, p^);
  end;
end;

procedure TDefaultObj.Return;
var
  i: integer;
begin
  inherited;
  for i := Low(FPropertys) to High(FPropertys) do
    if (FPropertys[i].BufLen > sizeOf(int64)) and (FPropertys[i].pBuf <> nil) then
      FreeMem(FPropertys[i].pBuf);
  SetLength(FPropertys, 0);
end;

{ TID_OBJ }

procedure TID_OBJ.Empty;
begin
  ObjIDLow := 0;
  ObjIDHigh := 0;
end;

class operator TID_OBJ.Equal(const id1, id2: TID_OBJ): boolean;
begin
  case id1.IDDetail.ObjType of
    OBJTYPE_SESSION:
      Result := CompareMem(@id1, @id2, sizeOf(TID_OBJ) - sizeOf(longword));
    else
      Result := (id1.ObjIDLow = id2.ObjIDLow) and (id1.ObjIDHigh = id2.ObjIDHigh);
  end;
end;

procedure TID_OBJ.FromStr(s: CommonString);
var
  i: integer;
  c: char;
begin
  Empty;
  if (Length(s) > 2) and (s[2] = '-') then
  begin
    s := UpperCase(s);
    c := s[1];
    Delete(s, 1, 2);
    for i := Low(S_OBJTYPE_CHAR) to High(S_OBJTYPE_CHAR) do
      if S_OBJTYPE_CHAR[i] = c then
      begin
        IDDetail.ObjType := i;
        StrToBuf(s, IDDetail.SvrMdl.Svr, sizeOf(TID_OBJ));
        Break;
      end;
  end
  else
    StrToBuf(s, IDDetail.ObjType, sizeOf(TID_OBJ));
end;

procedure TID_OBJ.GenericID(ot: byte; st: byte);
var
  i: integer;
begin
  IDDetail.ObjType := ot;
  IDDetail.SubType := st;
  for i := Low(IDDetail.SubID.IDBuf) to High(IDDetail.SubID.IDBuf) do
    IDDetail.SubID.IDBuf[i] := Random(256);
end;

class operator TID_OBJ.GreaterThan(const id1, id2: TID_OBJ): boolean;
begin
  if id1.ObjIDHigh > id2.ObjIDHigh then
    Result := True
  else if (id1.ObjIDHigh = id2.ObjIDHigh) then
    Result := id1.ObjIDLow > id2.ObjIDLow
  else
    Result := False;
end;

class operator TID_OBJ.GreaterThanOrEqual(const id1, id2: TID_OBJ): boolean;
begin
  if id1.ObjIDHigh > id2.ObjIDHigh then
    Result := True
  else if id1.ObjIDHigh = id2.ObjIDHigh then
    Result := id1.ObjIDLow >= id2.ObjIDLow
  else
    Result := False;
end;

function TID_OBJ.IsEmpty: boolean;
begin
  Result := (ObjIDLow = 0) and (ObjIDHigh = 0);
end;

function TID_OBJ.IsWildCard(const id: TID_OBJ): boolean;
begin
  case id.IDDetail.ObjType of
    OBJTYPE_ENTITY:
      Result := id.IDDetail.SvrMdl.HostID = HOSTID_ALLMASK;
    OBJTYPE_ID:
      Result := id.IDDetail.SubID.LUserID = $FFFF;
    else
      Result := False;
  end;
end;

class operator TID_OBJ.LessThan(const id1, id2: TID_OBJ): boolean;
begin
  if id1.ObjIDHigh < id2.ObjIDHigh then
    Result := True
  else if (id1.ObjIDHigh = id2.ObjIDHigh) then
    Result := id1.ObjIDLow < id2.ObjIDLow
  else
    Result := False;
end;

class operator TID_OBJ.LessThanOrEqual(const id1, id2: TID_OBJ): boolean;
begin
  if id1.ObjIDHigh < id2.ObjIDHigh then
    Result := True
  else if id1.ObjIDHigh = id2.ObjIDHigh then
    Result := id1.ObjIDLow <= id2.ObjIDLow
  else
    Result := False;
end;

class operator TID_OBJ.NotEqual(const id1, id2: TID_OBJ): boolean;
begin
  Result := (id1.ObjIDLow <> id2.ObjIDLow) or (id1.ObjIDHigh <> id2.ObjIDHigh);
end;

function TID_OBJ.ToString: CommonString;
begin
  if IDDetail.ObjType in [OBJTYPE_LOW .. OBJTYPE_HIGH] then
    Result := S_OBJTYPE_CHAR[IDDetail.ObjType] + '-' + BufToStr(IDDetail.SvrMdl.Svr, sizeOf(TID_OBJ) - 1)
  else
    Result := BufToStr(Self, sizeOf(Self));
end;

{ TID_HOST }

procedure TID_HOST.Empty;
begin
  HostIDLow := 0;
  HostIDHigh := 0;
end;

class operator TID_HOST.Equal(const hid1, hid2: TID_HOST): boolean;
begin
  Result := (hid1.HostIDLow = hid2.HostIDLow) and (hid1.HostIDHigh = hid2.HostIDHigh);
end;

procedure TID_HOST.FromStr(s: CommonString);
begin
  StrToBuf(s, HostID, sizeOf(TID_HOST));
end;

procedure TID_HOST.GeneralHostID;
var
  i: integer;
begin
  for i := Low(HostID) to High(HostID) do
    HostID[i] := Random(256);
end;

function TID_HOST.IsEmpty: boolean;
begin
  Result := (HostIDLow = 0) and (HostIDHigh = 0);
end;

class operator TID_HOST.NotEqual(const hid1, hid2: TID_HOST): boolean;
begin
  Result := (hid1.HostIDLow <> hid2.HostIDLow) or (hid1.HostIDHigh <> hid2.HostIDHigh);
end;

function TID_HOST.ToStr: CommonString;
begin
  Result := BufToStr(HostID, sizeOf(HostID));
end;

{ TID_MODULE }

procedure TID_MODULE.Empty;
begin
  ModuleID := 0;
end;

class operator TID_MODULE.Equal(mid1, mid2: TID_MODULE): boolean;
begin
  Result := mid1.ModuleID = mid2.ModuleID;
end;

function TID_MODULE.IsEmpty: longbool;
begin
  Result := ModuleID = 0;
end;

class operator TID_MODULE.NotEqual(mid1, mid2: TID_MODULE): boolean;
begin
  Result := mid1.ModuleID <> mid2.ModuleID;
end;

{ TSize4DataSet }

procedure TSize4DataSet.AddData(d: longword);
var
  l: integer;
begin
  l := Length(FDatas);
  SetLength(FDatas, l + 1);
  FDatas[l] := d;
  DoModifyed;
end;

class function TSize4DataSet.ClassID: longword;
begin
  Result := CLASSID_SIZE4DATASET;
end;

procedure TSize4DataSet.Clear;
begin
  SetLength(FDatas, 0);
  DoModifyed;
end;

function TSize4DataSet.DataCount: integer;
begin
  Result := Length(FDatas);
end;

procedure TSize4DataSet.DoAssign(Source: TSerialObj);
var
  src: TSize4DataSet absolute Source;
  i: integer;
begin
  inherited;
  SetLength(FDatas, Length(src.FDatas));
  for i := 0 to High(FDatas) do
    FDatas[i] := src.FDatas[i];
end;

procedure TSize4DataSet.DoClone(Target: TSerialObj);
var
  tgt: TSize4DataSet absolute Target;
  i: integer;
begin
  inherited;
  SetLength(tgt.FDatas, Length(FDatas));
  for i := 0 to High(FDatas) do
    tgt.FDatas[i] := FDatas[i];
end;

procedure TSize4DataSet.DoDumpObj;
begin
  inherited;
  DumpStr('  Count: %d', [Length(FDatas)]);
end;

procedure TSize4DataSet.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    10:
      if Len > 0 then
      begin
        SetLength(FDatas, Len div 4);
        Buf.ReadBuf(FDatas[0], Len);
      end;
    else
      inherited;
  end;
end;

procedure TSize4DataSet.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  inherited;
  WriteSize4ComboProperty(dp, 10, FDatas);
end;

procedure TSize4DataSet.DelDatas(c: integer);
var
  i: integer;
begin
  if c > 0 then
  begin
    if c >= Length(FDatas) then
      SetLength(FDatas, 0)
    else
    begin
      for i := c to High(FDatas) do
        FDatas[i - c] := FDatas[i];
      SetLength(FDatas, Length(FDatas) - c);
    end;
    DoModifyed;
  end;
end;

function TSize4DataSet.GetData(Idx: integer): longword;
begin
  if (Idx >= 0) and (Idx < Length(FDatas)) then
    Result := FDatas[Idx]
  else
    Result := 0;
end;

procedure TSize4DataSet.Return;
begin
  inherited;
  SetLength(FDatas, 0);
end;

procedure TSize4DataSet.SetData(Idx: integer; d: longword);
begin
  if Length(FDatas) < Idx + 1 then
    SetLength(FDatas, Idx + 1);
  if FDatas[Idx] <> d then
  begin
    FDatas[Idx] := d;
    DoModifyed;
  end;
end;

function EnumPath(path: CommonString; fullpath: boolean; IncludeSubDir: boolean): TStringObj;

  procedure RescureEnum(path: CommonString; o: TStringObj);
  var
    sr: TSearchRec;
    so: TStringObj;
  begin
    if FindFirst(path + '*.*', faAnyFile, sr) = 0 then
    begin
      while FindNext(sr) = 0 do
      begin
        if (sr.Name <> '.') and (sr.Name <> '..') then
        begin
          so := ObjPool.GetObj(TStringObj, nil);
          if fullpath then
            so.Str := path + sr.Name
          else
            so.Str := sr.Name;
          o.AddObj(so);
          if sr.Attr and faDirectory <> 0 then
            if IncludeSubDir then
              RescureEnum(path + sr.Name + PathDelim, so)
            else
              ObjPool.ReturnObj(so, nil);
        end;
      end;
      FindClose(sr);
    end;
  end;

begin
  Result := ObjPool.GetObj(TStringObj, nil);
  Result.Str := path;
  path := RegularPath(path);
  RescureEnum(path, Result);
end;

function FlatEnumPath(path: CommonString; extfilter: TCommStrArr): TStringObj;

  function CheckExt(s: CommonString): boolean;
  var
    ext: CommonString;
    i: integer;
  begin
    if Length(extfilter) = 0 then
      Result := True
    else
    begin
      ext := ExtractFileExt(s);
      if (ext <> '') then
        Delete(ext, 1, 1);
      Result := False;
      for i := Low(extfilter) to High(extfilter) do
        if extfilter[i] = ext then
        begin
          Result := True;
          Break;
        end;
    end;
  end;

  procedure RescureEnum(path: CommonString);
  var
    sr: TSearchRec;
    so: TStringObj;
  begin
    if FindFirst(path + '*.*', faAnyFile, sr) = 0 then
    begin
      while FindNext(sr) = 0 do
      begin
        if (sr.Name <> '.') and (sr.Name <> '..') then
          if sr.Attr and faDirectory <> 0 then
            RescureEnum(path + sr.Name + PathDelim)
          else if CheckExt(sr.Name) then
          begin
            so := ObjPool.GetObj(TStringObj, nil);
            so.FStr := path + sr.Name;
            Result.AddObj(so);
          end;
      end;
      FindClose(sr);
    end;
  end;

begin
  Result := ObjPool.GetObj(TStringObj, nil);
  Result.Str := path;
  path := RegularPath(path);
  RescureEnum(path);
end;

{ TMemContent }

// class function TMemContent.ClassID: LongWord;
// begin
// Result := CLASSID_MEMCONTENT;
// end;

// procedure TMemContent.DoAssign(Source: TSerialObj);
// var
// src: TMemContent absolute Source;
// begin
// inherited;
// MemEntity := src.MemEntity;
// FMem := src.FMem;
// FBufLen := src.FBufLen;
// end;

// procedure TMemContent.DoClone(Target: TSerialObj);
// var
// tgt: TMemContent absolute Target;
// begin
// inherited;
// tgt.MemEntity := MemEntity;
// tgt.FMem := FMem;
// tgt.FBufLen := FBufLen;
// end;

// procedure TMemContent.DoReadFromPack(PropertyIdx, Len: LongWord; Buf: TIOCPDataCollecter);
// var
// me: TMemoryEntity;
// begin
// case PropertyIdx of
// 1:
// begin
// me := ObjPool.GetObj(TMemoryEntity, Self);
// me.ReadFromDC(Buf, Len);
// MemEntity := me;
// end;
// else
// inherited;
// end;
// end;

// procedure TMemContent.DoWritePropertyToPack(dp: TIOCPDataCollecter);
// begin
// if (FMemEntity <> nil) and (FMemEntity.FBufLen > 0) then
// WritePropertyToPack(dp, 1, FMemEntity.FBufLen, FMemEntity.FMemBuf^);
// if (FMem <> nil) and (FBufLen > 0) then
// WritePropertyToPack(dp, 1, FBufLen, FMem^);
// inherited;
// end;

// procedure TMemContent.Return;
// begin
// if FMemEntity <> nil then
// begin
// FMemEntity.DecRef;
// FMemEntity := nil;
// end;
// FMem := nil;
// FBufLen := 0;
// inherited;
// end;

// procedure TMemContent.SetBufLen(const Value: LongWord);
// begin
// if FBufLen <> Value then
// begin
// FBufLen := Value;
// DoModifyed;
// end;
// end;

// procedure TMemContent.SetMemEntity(const Value: TMemoryEntity);
// begin
// if FMemEntity <> Value then
// begin
// if FMemEntity <> nil then
// FMemEntity.DecRef;
// FMemEntity := Value;
// if FMemEntity <> nil then
// Inc(FMemEntity.FRefCount);
// end;
// end;

{ TMemoryEntity }

// class function TMemoryEntity.ClassID: LongWord;
// begin
// Result := CLASSID_MEMPRYENTITY;
// end;

// procedure TMemoryEntity.DecRef;
// begin
// Dec(FRefCount);
// if FRefCount <= 0 then
// ObjPool.ReturnObj(Self, Self);
// end;

// procedure TMemoryEntity.ReadFromDC(dc: TIOCPDataCollecter; Len: LongWord);
// begin
// if FMemBuf <> nil then
// FreeMem(FMemBuf);
// GetMem(FMemBuf, Len);
// FBufLen := Len;
// if FMemBuf <> nil then
// dc.ReadBuf(FMemBuf^, Len);
// end;

// procedure TMemoryEntity.ReadFromGlobal(h: NativeUInt);
// var
// sz: LongWord;
// p: Pointer;
// begin
// sz := GlobalSize(h);
// SetBufLen(sz);
// if FMemBuf <> nil then
// begin
// p := GlobalLock(h);
// if p <> nil then
// Move(p^, FMemBuf^, sz);
// GlobalUnLock(h);
// end;
// end;

// procedure TMemoryEntity.Return;
// begin
// if FMemBuf <> nil then
// begin
// FreeMem(FMemBuf);
// FMemBuf := nil;
// end;
// inherited;
// end;

// procedure TMemoryEntity.SetBufLen(const Value: LongWord);
// begin
// if FBufLen <> Value then
// begin
// FBufLen := Value;
// if FMemBuf <> nil then
// FreeMem(FMemBuf);
// GetMem(FMemBuf, Value);
// end;
// end;

{ TMilliSecParam }

class function TMilliSecParam.ClassID: longword;
begin
  Result := CLASSID_MILLISECPARAM;
end;

procedure TMilliSecParam.Return;
begin
  inherited;

end;

procedure TMilliSecParam.SetIOCPKey(const Value: nativeuint);
begin
  FIOCPKey := Value;
end;

procedure TMilliSecParam.SetIOCPMsg(const Value: longword);
begin
  FIOCPMsg := Value;
end;

procedure TMilliSecParam.SetIOCPPort(const Value: nativeuint);
begin
  FIOCPPort := Value;
end;

{ TFileInfo }

class function TFileInfo.ClassID: longword;
begin
  Result := CLASSID_FILEINFO;
end;

procedure TFileInfo.DoAssign(Source: TSerialObj);
var
  src: TFileInfo absolute Source;
begin
  inherited;
  FSize := src.FSize;
  FModTime := src.FModTime;
end;

procedure TFileInfo.DoClone(Target: TSerialObj);
var
  tgt: TFileInfo absolute Target;
begin
  inherited;
  tgt.FSize := FSize;
  tgt.FModTime := FModTime;
end;

procedure TFileInfo.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    100:
      Buf.ReadBuf(FSize, Len);
    else
      inherited;
  end;
end;

procedure TFileInfo.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  inherited;
  WritePropertyToPack(dp, 100, sizeOf(FSize) + sizeOf(FModTime), FSize);
end;

procedure TFileInfo.Return;
begin
  inherited;
  FSize.fp64 := 0;
  FModTime := 0;
end;

procedure TFileInfo.SetModTime(const Value: longword);
begin
  if FModTime <> Value then
  begin
    FModTime := Value;
    DoModifyed;
  end;
end;

procedure TFileInfo.SetSize(const Value: TFILE_SIZE);
begin
  if FSize <> Value then
  begin
    FSize := Value;
    DoModifyed;
  end;
end;

initialization

  // DbgPrint(L_DBGLEVEL_DEBUG, 'Enter unitCommonDataStruct init');
  IsMultiThread := True;
  Randomize;
  ObjPool.RegisterObjClass(TFuncInfo);
  ObjPool.RegisterObjClass(TStringObj);
  ObjPool.RegisterObjClass(TStoreList);
  ObjPool.RegisterObjClass(TFileContent);
  ObjPool.RegisterObjClass(TStubObj);
  ObjPool.RegisterObjClass(TDefaultObj);
  ObjPool.RegisterObjClass(TSize4DataSet);
  ObjPool.RegisterObjClass(TMilliSecParam);
  ObjPool.RegisterObjClass(TFileInfo);
  // DbgPrint(L_DBGLEVEL_DEBUG, 'Exit unitCommonDataStruct init');

end.
